home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / generic / tkMenu.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  92.7 KB  |  3,049 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkMenu.c --
  3.  *
  4.  * This file contains most of the code for implementing menus in Tk. It takes
  5.  * care of all of the generic (platform-independent) parts of menus, and
  6.  * is supplemented by platform-specific files. The geometry calculation
  7.  * and drawing code for menus is in the file tkMenuDraw.c
  8.  *
  9.  * Copyright (c) 1990-1994 The Regents of the University of California.
  10.  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  11.  *
  12.  * See the file "license.terms" for information on usage and redistribution
  13.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14.  *
  15.  * SCCS: @(#) tkMenu.c 1.143 97/08/08 17:25:28
  16.  */
  17.  
  18. /*
  19.  * Notes on implementation of menus:
  20.  *
  21.  * Menus can be used in three ways:
  22.  * - as a popup menu, either as part of a menubutton or standalone.
  23.  * - as a menubar. The menu's cascade items are arranged according to
  24.  * the specific platform to provide the user access to the menus at all
  25.  * times
  26.  * - as a tearoff palette. This is a window with the menu's items in it.
  27.  *
  28.  * The goal is to provide the Tk developer with a way to use a common
  29.  * set of menus for all of these tasks.
  30.  *
  31.  * In order to make the bindings for cascade menus work properly under Unix,
  32.  * the cascade menus' pathnames must be proper children of the menu that
  33.  * they are cascade from. So if there is a menu .m, and it has two
  34.  * cascades labelled "File" and "Edit", the cascade menus might have
  35.  * the pathnames .m.file and .m.edit. Another constraint is that the menus
  36.  * used for menubars must be children of the toplevel widget that they
  37.  * are attached to. And on the Macintosh, the platform specific menu handle
  38.  * for cascades attached to a menu bar must have a title that matches the
  39.  * label for the cascade menu.
  40.  *
  41.  * To handle all of the constraints, Tk menubars and tearoff menus are
  42.  * implemented using menu clones. Menu clones are full menus in their own
  43.  * right; they have a Tk window and pathname associated with them; they have
  44.  * a TkMenu structure and array of entries. However, they are linked with the
  45.  * original menu that they were cloned from. The reflect the attributes of
  46.  * the original, or "master", menu. So if an item is added to a menu, and
  47.  * that menu has clones, then the item must be added to all of its clones
  48.  * also. Menus are cloned when a menu is torn-off or when a menu is assigned
  49.  * as a menubar using the "-menu" option of the toplevel's pathname configure
  50.  * subcommand. When a clone is destroyed, only the clone is destroyed, but
  51.  * when the master menu is destroyed, all clones are also destroyed. This
  52.  * allows the developer to just deal with one set of menus when creating
  53.  * and destroying.
  54.  *
  55.  * Clones are rather tricky when a menu with cascade entries is cloned (such
  56.  * as a menubar). Not only does the menu have to be cloned, but each cascade
  57.  * entry's corresponding menu must also be cloned. This maintains the pathname
  58.  * parent-child hierarchy necessary for menubars and toplevels to work.
  59.  * This leads to several special cases:
  60.  *
  61.  * 1. When a new menu is created, and it is pointed to by cascade entries in
  62.  * cloned menus, the new menu has to be cloned to parallel the cascade
  63.  * structure.
  64.  * 2. When a cascade item is added to a menu that has been cloned, and the
  65.  * menu that the cascade item points to exists, that menu has to be cloned.
  66.  * 3. When the menu that a cascade entry points to is changed, the old
  67.  * cloned cascade menu has to be discarded, and the new one has to be cloned.
  68.  *
  69.  */
  70.  
  71. #include "tkPort.h"
  72. #include "tkMenu.h"
  73.  
  74. #define MENU_HASH_KEY "tkMenus"
  75.  
  76. static int menusInitialized;    /* Whether or not the hash tables, etc., have
  77.                  * been setup */
  78.  
  79. /*
  80.  * Configuration specs for individual menu entries. If this changes, be sure
  81.  * to update code in TkpMenuInit that changes the font string entry.
  82.  */
  83.  
  84. Tk_ConfigSpec tkMenuEntryConfigSpecs[] = {
  85.     {TK_CONFIG_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
  86.     DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorder),
  87.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  88.     |TK_CONFIG_NULL_OK},
  89.     {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
  90.     DEF_MENU_ENTRY_ACTIVE_FG, Tk_Offset(TkMenuEntry, activeFg),
  91.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  92.     |TK_CONFIG_NULL_OK},
  93.     {TK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL,
  94.     DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(TkMenuEntry, accel),
  95.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  96.     |TK_CONFIG_NULL_OK},
  97.     {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
  98.     DEF_MENU_ENTRY_BG, Tk_Offset(TkMenuEntry, border),
  99.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  100.     |SEPARATOR_MASK|TEAROFF_MASK|TK_CONFIG_NULL_OK},
  101.     {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
  102.     DEF_MENU_ENTRY_BITMAP, Tk_Offset(TkMenuEntry, bitmap),
  103.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  104.     |TK_CONFIG_NULL_OK},
  105.     {TK_CONFIG_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
  106.     DEF_MENU_ENTRY_COLUMN_BREAK, Tk_Offset(TkMenuEntry, columnBreak),
  107.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
  108.     {TK_CONFIG_STRING, "-command", (char *) NULL, (char *) NULL,
  109.     DEF_MENU_ENTRY_COMMAND, Tk_Offset(TkMenuEntry, command),
  110.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  111.     |TK_CONFIG_NULL_OK},
  112.     {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
  113.     DEF_MENU_ENTRY_FONT, Tk_Offset(TkMenuEntry, tkfont),
  114.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  115.     |TK_CONFIG_NULL_OK},
  116.     {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
  117.     DEF_MENU_ENTRY_FG, Tk_Offset(TkMenuEntry, fg),
  118.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  119.     |TK_CONFIG_NULL_OK},
  120.     {TK_CONFIG_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
  121.     DEF_MENU_ENTRY_HIDE_MARGIN, Tk_Offset(TkMenuEntry, hideMargin),
  122.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  123.     |SEPARATOR_MASK|TEAROFF_MASK},
  124.     {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
  125.     DEF_MENU_ENTRY_IMAGE, Tk_Offset(TkMenuEntry, imageString),
  126.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  127.     |TK_CONFIG_NULL_OK},
  128.     {TK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
  129.     DEF_MENU_ENTRY_INDICATOR, Tk_Offset(TkMenuEntry, indicatorOn),
  130.     CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_DONT_SET_DEFAULT},
  131.     {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL,
  132.     DEF_MENU_ENTRY_LABEL, Tk_Offset(TkMenuEntry, label),
  133.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
  134.     {TK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL,
  135.     DEF_MENU_ENTRY_MENU, Tk_Offset(TkMenuEntry, name),
  136.     CASCADE_MASK|TK_CONFIG_NULL_OK},
  137.     {TK_CONFIG_STRING, "-offvalue", (char *) NULL, (char *) NULL,
  138.     DEF_MENU_ENTRY_OFF_VALUE, Tk_Offset(TkMenuEntry, offValue),
  139.     CHECK_BUTTON_MASK},
  140.     {TK_CONFIG_STRING, "-onvalue", (char *) NULL, (char *) NULL,
  141.     DEF_MENU_ENTRY_ON_VALUE, Tk_Offset(TkMenuEntry, onValue),
  142.     CHECK_BUTTON_MASK},
  143.     {TK_CONFIG_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
  144.     DEF_MENU_ENTRY_SELECT, Tk_Offset(TkMenuEntry, indicatorFg),
  145.     CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
  146.     {TK_CONFIG_STRING, "-selectimage", (char *) NULL, (char *) NULL,
  147.     DEF_MENU_ENTRY_SELECT_IMAGE, Tk_Offset(TkMenuEntry, selectImageString),
  148.     CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
  149.     {TK_CONFIG_UID, "-state", (char *) NULL, (char *) NULL,
  150.     DEF_MENU_ENTRY_STATE, Tk_Offset(TkMenuEntry, state),
  151.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  152.     |TEAROFF_MASK|TK_CONFIG_DONT_SET_DEFAULT},
  153.     {TK_CONFIG_STRING, "-value", (char *) NULL, (char *) NULL,
  154.     DEF_MENU_ENTRY_VALUE, Tk_Offset(TkMenuEntry, onValue),
  155.     RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
  156.     {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
  157.     DEF_MENU_ENTRY_CHECK_VARIABLE, Tk_Offset(TkMenuEntry, name),
  158.     CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
  159.     {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
  160.     DEF_MENU_ENTRY_RADIO_VARIABLE, Tk_Offset(TkMenuEntry, name),
  161.     RADIO_BUTTON_MASK},
  162.     {TK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL,
  163.     DEF_MENU_ENTRY_UNDERLINE, Tk_Offset(TkMenuEntry, underline),
  164.     COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
  165.     |TK_CONFIG_DONT_SET_DEFAULT},
  166.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  167.     (char *) NULL, 0, 0}
  168. };
  169.  
  170. /*
  171.  * Configuration specs valid for the menu as a whole. If this changes, be sure
  172.  * to update code in TkpMenuInit that changes the font string entry.
  173.  */
  174.  
  175. Tk_ConfigSpec tkMenuConfigSpecs[] = {
  176.     {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
  177.     DEF_MENU_ACTIVE_BG_COLOR, Tk_Offset(TkMenu, activeBorder),
  178.     TK_CONFIG_COLOR_ONLY},
  179.     {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
  180.     DEF_MENU_ACTIVE_BG_MONO, Tk_Offset(TkMenu, activeBorder),
  181.     TK_CONFIG_MONO_ONLY},
  182.     {TK_CONFIG_PIXELS, "-activeborderwidth", "activeBorderWidth",
  183.         "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
  184.         Tk_Offset(TkMenu, activeBorderWidth), 0},
  185.     {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
  186.     DEF_MENU_ACTIVE_FG_COLOR, Tk_Offset(TkMenu, activeFg),
  187.     TK_CONFIG_COLOR_ONLY},
  188.     {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
  189.     DEF_MENU_ACTIVE_FG_MONO, Tk_Offset(TkMenu, activeFg),
  190.     TK_CONFIG_MONO_ONLY},
  191.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  192.     DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, border), TK_CONFIG_COLOR_ONLY},
  193.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  194.     DEF_MENU_BG_MONO, Tk_Offset(TkMenu, border), TK_CONFIG_MONO_ONLY},
  195.     {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
  196.     (char *) NULL, 0, 0},
  197.     {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
  198.     (char *) NULL, 0, 0},
  199.     {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
  200.     DEF_MENU_BORDER_WIDTH, Tk_Offset(TkMenu, borderWidth), 0},
  201.     {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
  202.     DEF_MENU_CURSOR, Tk_Offset(TkMenu, cursor), TK_CONFIG_NULL_OK},
  203.     {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
  204.     "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
  205.     Tk_Offset(TkMenu, disabledFg), TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
  206.     {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
  207.     "DisabledForeground", DEF_MENU_DISABLED_FG_MONO,
  208.     Tk_Offset(TkMenu, disabledFg), TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
  209.     {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
  210.     (char *) NULL, 0, 0},
  211.     {TK_CONFIG_FONT, "-font", "font", "Font",
  212.     DEF_MENU_FONT, Tk_Offset(TkMenu, tkfont), 0},
  213.     {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
  214.     DEF_MENU_FG, Tk_Offset(TkMenu, fg), 0},
  215.     {TK_CONFIG_STRING, "-postcommand", "postCommand", "Command",
  216.     DEF_MENU_POST_COMMAND, Tk_Offset(TkMenu, postCommand),
  217.         TK_CONFIG_NULL_OK},
  218.     {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
  219.     DEF_MENU_RELIEF, Tk_Offset(TkMenu, relief), 0},
  220.     {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
  221.     DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFg),
  222.     TK_CONFIG_COLOR_ONLY},
  223.     {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
  224.     DEF_MENU_SELECT_MONO, Tk_Offset(TkMenu, indicatorFg),
  225.     TK_CONFIG_MONO_ONLY},
  226.     {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
  227.     DEF_MENU_TAKE_FOCUS, Tk_Offset(TkMenu, takeFocus), TK_CONFIG_NULL_OK},
  228.     {TK_CONFIG_BOOLEAN, "-tearoff", "tearOff", "TearOff",
  229.     DEF_MENU_TEAROFF, Tk_Offset(TkMenu, tearOff), 0},
  230.     {TK_CONFIG_STRING, "-tearoffcommand", "tearOffCommand", "TearOffCommand",
  231.     DEF_MENU_TEAROFF_CMD, Tk_Offset(TkMenu, tearOffCommand),
  232.     TK_CONFIG_NULL_OK},
  233.     {TK_CONFIG_STRING, "-title", "title", "Title",
  234.         DEF_MENU_TITLE, Tk_Offset(TkMenu, title), TK_CONFIG_NULL_OK},
  235.     {TK_CONFIG_STRING, "-type", "type", "Type",
  236.     DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypeName), TK_CONFIG_NULL_OK},
  237.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  238.     (char *) NULL, 0, 0}
  239. };
  240.  
  241. /*
  242.  * Prototypes for static procedures in this file:
  243.  */
  244.  
  245. static int        CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
  246.                 char *newMenuName, char *newMenuTypeString));
  247. static int        ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
  248.                 TkMenu *menuPtr, int argc, char **argv,
  249.                 int flags));
  250. static int        ConfigureMenuCloneEntries _ANSI_ARGS_((
  251.                 Tcl_Interp *interp, TkMenu *menuPtr, int index,
  252.                 int argc, char **argv, int flags));
  253. static int        ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
  254.                 int argc, char **argv, int flags));
  255. static void        DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
  256.                 int first, int last));
  257. static void        DestroyMenuHashTable _ANSI_ARGS_((
  258.                 ClientData clientData, Tcl_Interp *interp));
  259. static void        DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr));
  260. static void        DestroyMenuEntry _ANSI_ARGS_((char *memPtr));
  261. static int        GetIndexFromCoords
  262.                 _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
  263.                 char *string, int *indexPtr));
  264. static int        MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
  265.                 TkMenu *menuPtr, char *arg));
  266. static int        MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
  267.                 TkMenu *menuPtr, char *indexString, int argc,
  268.                 char **argv));
  269. static void        MenuCmdDeletedProc _ANSI_ARGS_((
  270.                 ClientData clientData));
  271. static TkMenuEntry *    MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
  272.                 int type));
  273. static char *        MenuVarProc _ANSI_ARGS_((ClientData clientData,
  274.                 Tcl_Interp *interp, char *name1, char *name2,
  275.                 int flags));
  276. static int        MenuWidgetCmd _ANSI_ARGS_((ClientData clientData,
  277.                 Tcl_Interp *interp, int argc, char **argv));
  278. static void        MenuWorldChanged _ANSI_ARGS_((
  279.                 ClientData instanceData));
  280. static void        RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr));
  281. static void        UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
  282.  
  283. /*
  284.  * The structure below is a list of procs that respond to certain window
  285.  * manager events. One of these includes a font change, which forces
  286.  * the geometry proc to be called.
  287.  */
  288.  
  289. static TkClassProcs menuClass = {
  290.     NULL,            /* createProc. */
  291.     MenuWorldChanged        /* geometryProc. */
  292. };
  293.  
  294.  
  295.  
  296. /*
  297.  *--------------------------------------------------------------
  298.  *
  299.  * Tk_MenuCmd --
  300.  *
  301.  *    This procedure is invoked to process the "menu" Tcl
  302.  *    command.  See the user documentation for details on
  303.  *    what it does.
  304.  *
  305.  * Results:
  306.  *    A standard Tcl result.
  307.  *
  308.  * Side effects:
  309.  *    See the user documentation.
  310.  *
  311.  *--------------------------------------------------------------
  312.  */
  313.  
  314. int
  315. Tk_MenuCmd(clientData, interp, argc, argv)
  316.     ClientData clientData;    /* Main window associated with
  317.                  * interpreter. */
  318.     Tcl_Interp *interp;        /* Current interpreter. */
  319.     int argc;            /* Number of arguments. */
  320.     char **argv;        /* Argument strings. */
  321. {
  322.     Tk_Window tkwin = (Tk_Window) clientData;
  323.     Tk_Window new;
  324.     register TkMenu *menuPtr;
  325.     TkMenuReferences *menuRefPtr;
  326.     int i, len;
  327.     char *arg, c;
  328.     int toplevel;
  329.  
  330.     if (argc < 2) {
  331.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  332.         argv[0], " pathName ?options?\"", (char *) NULL);
  333.     return TCL_ERROR;
  334.     }
  335.  
  336.     TkMenuInit();
  337.  
  338.     toplevel = 1;
  339.     for (i = 2; i < argc; i++) {
  340.     arg = argv[i];
  341.     len = strlen(arg);
  342.     if (len < 2) {
  343.         continue;
  344.     }
  345.     c = arg[1];
  346.     if ((c == 't') && (strncmp(arg, "-type", strlen(arg)) == 0)
  347.         && (len >= 3)) {
  348.         if (strcmp(argv[i + 1], "menubar") == 0) {
  349.         toplevel = 0;
  350.         }
  351.     }
  352.     }
  353.  
  354.     new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], toplevel ? ""
  355.         : NULL);
  356.     if (new == NULL) {
  357.     return TCL_ERROR;
  358.     }
  359.  
  360.     /*
  361.      * Initialize the data structure for the menu.
  362.      */
  363.  
  364.     menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu));
  365.     menuPtr->tkwin = new;
  366.     menuPtr->display = Tk_Display(new);
  367.     menuPtr->interp = interp;
  368.     menuPtr->widgetCmd = Tcl_CreateCommand(interp,
  369.         Tk_PathName(menuPtr->tkwin), MenuWidgetCmd,
  370.         (ClientData) menuPtr, MenuCmdDeletedProc);
  371.     menuPtr->entries = NULL;
  372.     menuPtr->numEntries = 0;
  373.     menuPtr->active = -1;
  374.     menuPtr->border = NULL;
  375.     menuPtr->borderWidth = 0;
  376.     menuPtr->relief = TK_RELIEF_FLAT;
  377.     menuPtr->activeBorder = NULL;
  378.     menuPtr->activeBorderWidth = 0;
  379.     menuPtr->tkfont = NULL;
  380.     menuPtr->fg = NULL;
  381.     menuPtr->disabledFg = NULL;
  382.     menuPtr->activeFg = NULL;
  383.     menuPtr->indicatorFg = NULL;
  384.     menuPtr->tearOff = 1;
  385.     menuPtr->tearOffCommand = NULL;
  386.     menuPtr->cursor = None;
  387.     menuPtr->takeFocus = NULL;
  388.     menuPtr->postCommand = NULL;
  389.     menuPtr->postCommandGeneration = 0;
  390.     menuPtr->postedCascade = NULL;
  391.     menuPtr->nextInstancePtr = NULL;
  392.     menuPtr->masterMenuPtr = menuPtr;
  393.     menuPtr->menuType = UNKNOWN_TYPE;
  394.     menuPtr->menuFlags = 0;
  395.     menuPtr->parentTopLevelPtr = NULL;
  396.     menuPtr->menuTypeName = NULL;
  397.     menuPtr->title = NULL;
  398.     TkMenuInitializeDrawingFields(menuPtr);
  399.  
  400.     menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
  401.         Tk_PathName(menuPtr->tkwin));
  402.     menuRefPtr->menuPtr = menuPtr;
  403.     menuPtr->menuRefPtr = menuRefPtr;
  404.     if (TCL_OK != TkpNewMenu(menuPtr)) {
  405.         goto error;
  406.     }
  407.  
  408.     Tk_SetClass(menuPtr->tkwin, "Menu");
  409.     TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
  410.     Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
  411.         TkMenuEventProc, (ClientData) menuPtr);
  412.     if (ConfigureMenu(interp, menuPtr, argc-2, argv+2, 0) != TCL_OK) {
  413.     goto error;
  414.     }
  415.  
  416.     /*
  417.      * If a menu has a parent menu pointing to it as a cascade entry, the
  418.      * parent menu needs to be told that this menu now exists so that
  419.      * the platform-part of the menu is correctly updated.
  420.      *
  421.      * If a menu has an instance and has cascade entries, then each cascade
  422.      * menu must also have a parallel instance. This is especially true on
  423.      * the Mac, where each menu has to have a separate title everytime it is in
  424.      * a menubar. For instance, say you have a menu .m1 with a cascade entry
  425.      * for .m2, where .m2 does not exist yet. You then put .m1 into a menubar.
  426.      * This creates a menubar instance for .m1, but since .m2 is not there,
  427.      * nothing else happens. When we go to create .m2, we hook it up properly
  428.      * with .m1. However, we now need to clone .m2 and assign the clone of .m2
  429.      * to be the cascade entry for the clone of .m1. This is special case
  430.      * #1 listed in the introductory comment.
  431.      */
  432.     
  433.     if (menuRefPtr->parentEntryPtr != NULL) {
  434.         TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
  435.         TkMenuEntry *nextCascadePtr;
  436.         char *newMenuName;
  437.         char *newArgv[2];
  438.  
  439.         while (cascadeListPtr != NULL) {
  440.  
  441.         nextCascadePtr = cascadeListPtr->nextCascadePtr;
  442.      
  443.              /*
  444.               * If we have a new master menu, and an existing cloned menu
  445.          * points to this menu in a cascade entry, we have to clone
  446.          * the new menu and point the entry to the clone instead
  447.          * of the menu we are creating. Otherwise, ConfigureMenuEntry
  448.          * will hook up the platform-specific cascade linkages now
  449.          * that the menu we are creating exists.
  450.               */
  451.               
  452.              if ((menuPtr->masterMenuPtr != menuPtr)
  453.                      || ((menuPtr->masterMenuPtr == menuPtr)
  454.                      && ((cascadeListPtr->menuPtr->masterMenuPtr
  455.             == cascadeListPtr->menuPtr)))) {
  456.         newArgv[0] = "-menu";
  457.         newArgv[1] = Tk_PathName(menuPtr->tkwin);
  458.                  ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
  459.                      TK_CONFIG_ARGV_ONLY);
  460.              } else {
  461.                   newMenuName = TkNewMenuName(menuPtr->interp,
  462.                      Tk_PathName(cascadeListPtr->menuPtr->tkwin),
  463.                      menuPtr);
  464.                 CloneMenu(menuPtr, newMenuName, "normal");
  465.                     
  466.                 /*
  467.                  * Now we can set the new menu instance to be the cascade entry
  468.                  * of the parent's instance.
  469.                  */
  470.  
  471.         newArgv[0] = "-menu";
  472.                 newArgv[1] = newMenuName;
  473.                 ConfigureMenuEntry(cascadeListPtr, 2, newArgv, 
  474.                     TK_CONFIG_ARGV_ONLY);
  475.             if (newMenuName != NULL) {
  476.                 ckfree(newMenuName);
  477.             }
  478.             }
  479.             cascadeListPtr = nextCascadePtr;
  480.         }
  481.     }
  482.     
  483.     /*
  484.      * If there already exist toplevel widgets that refer to this menu,
  485.      * find them and notify them so that they can reconfigure their
  486.      * geometry to reflect the menu.
  487.      */
  488.  
  489.     if (menuRefPtr->topLevelListPtr != NULL) {
  490.         TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr;
  491.         TkMenuTopLevelList *nextPtr;
  492.         Tk_Window listtkwin;
  493.        while (topLevelListPtr != NULL) {
  494.         
  495.             /*
  496.              * Need to get the next pointer first. TkSetWindowMenuBar
  497.              * changes the list, so that the next pointer is different
  498.              * after calling it.
  499.              */
  500.         
  501.             nextPtr = topLevelListPtr->nextPtr;
  502.             listtkwin = topLevelListPtr->tkwin;
  503.             TkSetWindowMenuBar(menuPtr->interp, listtkwin, 
  504.                     Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin));
  505.             topLevelListPtr = nextPtr;
  506.         }
  507.     }
  508.  
  509.     interp->result = Tk_PathName(menuPtr->tkwin);
  510.     return TCL_OK;
  511.  
  512.     error:
  513.     Tk_DestroyWindow(menuPtr->tkwin);
  514.     return TCL_ERROR;
  515. }
  516.  
  517. /*
  518.  *--------------------------------------------------------------
  519.  *
  520.  * MenuWidgetCmd --
  521.  *
  522.  *    This procedure is invoked to process the Tcl command
  523.  *    that corresponds to a widget managed by this module.
  524.  *    See the user documentation for details on what it does.
  525.  *
  526.  * Results:
  527.  *    A standard Tcl result.
  528.  *
  529.  * Side effects:
  530.  *    See the user documentation.
  531.  *
  532.  *--------------------------------------------------------------
  533.  */
  534.  
  535. static int
  536. MenuWidgetCmd(clientData, interp, argc, argv)
  537.     ClientData clientData;    /* Information about menu widget. */
  538.     Tcl_Interp *interp;        /* Current interpreter. */
  539.     int argc;            /* Number of arguments. */
  540.     char **argv;        /* Argument strings. */
  541. {
  542.     register TkMenu *menuPtr = (TkMenu *) clientData;
  543.     register TkMenuEntry *mePtr;
  544.     int result = TCL_OK;
  545.     size_t length;
  546.     int c;
  547.  
  548.     if (argc < 2) {
  549.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  550.         argv[0], " option ?arg arg ...?\"", (char *) NULL);
  551.     return TCL_ERROR;
  552.     }
  553.     Tcl_Preserve((ClientData) menuPtr);
  554.     c = argv[1][0];
  555.     length = strlen(argv[1]);
  556.     if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)
  557.         && (length >= 2)) {
  558.     int index;
  559.  
  560.     if (argc != 3) {
  561.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  562.             argv[0], " activate index\"", (char *) NULL);
  563.         goto error;
  564.     }
  565.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
  566.         goto error;
  567.     }
  568.     if (menuPtr->active == index) {
  569.         goto done;
  570.     }
  571.     if (index >= 0) {
  572.         if ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
  573.             || (menuPtr->entries[index]->state == tkDisabledUid)) {
  574.         index = -1;
  575.         }
  576.     }
  577.     result = TkActivateMenuEntry(menuPtr, index);
  578.     } else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)
  579.         && (length >= 2)) {
  580.     if (argc < 3) {
  581.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  582.             argv[0], " add type ?options?\"", (char *) NULL);
  583.         goto error;
  584.     }
  585.     if (MenuAddOrInsert(interp, menuPtr, (char *) NULL,
  586.         argc-2, argv+2) != TCL_OK) {
  587.         goto error;
  588.     }
  589.     } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
  590.         && (length >= 2)) {
  591.     if (argc != 3) {
  592.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  593.             argv[0], " cget option\"",
  594.             (char *) NULL);
  595.         goto error;
  596.     }
  597.     result = Tk_ConfigureValue(interp, menuPtr->tkwin, tkMenuConfigSpecs,
  598.         (char *) menuPtr, argv[2], 0);
  599.     } else if ((c == 'c') && (strncmp(argv[1], "clone", length) == 0)
  600.             && (length >=2)) {
  601.         if ((argc < 3) || (argc > 4)) {
  602.             Tcl_AppendResult(interp, "wrong # args: should be \"",
  603.                     argv[0], " clone newMenuName ?menuType?\"",
  604.                     (char *) NULL);
  605.             goto error;
  606.         }
  607.         result = CloneMenu(menuPtr, argv[2], (argc == 3) ? NULL : argv[3]);
  608.     } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
  609.         && (length >= 2)) {
  610.     if (argc == 2) {
  611.         result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
  612.             tkMenuConfigSpecs, (char *) menuPtr, (char *) NULL, 0);
  613.     } else if (argc == 3) {
  614.         result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
  615.             tkMenuConfigSpecs, (char *) menuPtr, argv[2], 0);
  616.     } else {
  617.         result = ConfigureMenu(interp, menuPtr, argc-2, argv+2,
  618.             TK_CONFIG_ARGV_ONLY);
  619.     }
  620.     } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
  621.     int first, last;
  622.  
  623.     if ((argc != 3) && (argc != 4)) {
  624.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  625.             argv[0], " delete first ?last?\"", (char *) NULL);
  626.         goto error;
  627.     }
  628.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &first) != TCL_OK) {
  629.         goto error;
  630.     }
  631.     if (argc == 3) {
  632.         last = first;
  633.     } else {
  634.         if (TkGetMenuIndex(interp, menuPtr, argv[3], 0, &last) != TCL_OK) {
  635.             goto error;
  636.         }
  637.     }
  638.     if (menuPtr->tearOff && (first == 0)) {
  639.  
  640.         /*
  641.          * Sorry, can't delete the tearoff entry;  must reconfigure
  642.          * the menu.
  643.          */
  644.         
  645.         first = 1;
  646.     }
  647.     if ((first < 0) || (last < first)) {
  648.         goto done;
  649.     }
  650.     DeleteMenuCloneEntries(menuPtr, first, last);
  651.     } else if ((c == 'e') && (length >= 7)
  652.         && (strncmp(argv[1], "entrycget", length) == 0)) {
  653.     int index;
  654.  
  655.     if (argc != 4) {
  656.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  657.             argv[0], " entrycget index option\"",
  658.             (char *) NULL);
  659.         goto error;
  660.     }
  661.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
  662.         goto error;
  663.     }
  664.     if (index < 0) {
  665.         goto done;
  666.     }
  667.     mePtr = menuPtr->entries[index];
  668.     Tcl_Preserve((ClientData) mePtr);
  669.     result = Tk_ConfigureValue(interp, menuPtr->tkwin,
  670.         tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
  671.         COMMAND_MASK << mePtr->type);
  672.     Tcl_Release((ClientData) mePtr);
  673.     } else if ((c == 'e') && (length >= 7)
  674.         && (strncmp(argv[1], "entryconfigure", length) == 0)) {
  675.     int index;
  676.  
  677.     if (argc < 3) {
  678.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  679.             argv[0], " entryconfigure index ?option value ...?\"",
  680.             (char *) NULL);
  681.         goto error;
  682.     }
  683.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
  684.         goto error;
  685.     }
  686.     if (index < 0) {
  687.         goto done;
  688.     }
  689.     mePtr = menuPtr->entries[index];
  690.     Tcl_Preserve((ClientData) mePtr);
  691.     if (argc == 3) {
  692.         result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
  693.             tkMenuEntryConfigSpecs, (char *) mePtr, (char *) NULL,
  694.             COMMAND_MASK << mePtr->type);
  695.     } else if (argc == 4) {
  696.         result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
  697.             tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
  698.             COMMAND_MASK << mePtr->type);
  699.     } else {
  700.         result = ConfigureMenuCloneEntries(interp, menuPtr, index, 
  701.                 argc-3, argv+3, 
  702.                 TK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type);
  703.     }
  704.     Tcl_Release((ClientData) mePtr);
  705.     } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
  706.         && (length >= 3)) {
  707.     int index;
  708.  
  709.     if (argc != 3) {
  710.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  711.             argv[0], " index string\"", (char *) NULL);
  712.         goto error;
  713.     }
  714.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
  715.         goto error;
  716.     }
  717.     if (index < 0) {
  718.         interp->result = "none";
  719.     } else {
  720.         sprintf(interp->result, "%d", index);
  721.     }
  722.     } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
  723.         && (length >= 3)) {
  724.     if (argc < 4) {
  725.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  726.             argv[0], " insert index type ?options?\"", (char *) NULL);
  727.         goto error;
  728.     }
  729.     if (MenuAddOrInsert(interp, menuPtr, argv[2],
  730.         argc-3, argv+3) != TCL_OK) {
  731.         goto error;
  732.     }
  733.     } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)
  734.         && (length >= 3)) {
  735.     int index;
  736.  
  737.     if (argc != 3) {
  738.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  739.             argv[0], " invoke index\"", (char *) NULL);
  740.         goto error;
  741.     }
  742.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
  743.         goto error;
  744.     }
  745.     if (index < 0) {
  746.         goto done;
  747.     }
  748.     result = TkInvokeMenu(interp, menuPtr, index);
  749.     } else if ((c == 'p') && (strncmp(argv[1], "post", length) == 0)
  750.         && (length == 4)) {
  751.     int x, y;
  752.  
  753.     if (argc != 4) {
  754.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  755.             argv[0], " post x y\"", (char *) NULL);
  756.         goto error;
  757.     }
  758.     if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
  759.         || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
  760.         goto error;
  761.     }
  762.  
  763.     /*
  764.      * Tearoff menus are posted differently on Mac and Windows than
  765.      * non-tearoffs. TkpPostMenu does not actually map the menu's
  766.      * window on those platforms, and popup menus have to be
  767.      * handled specially.
  768.      */
  769.     
  770.         if (menuPtr->menuType != TEAROFF_MENU) {
  771.             result = TkpPostMenu(interp, menuPtr, x, y);
  772.         } else {
  773.             result = TkPostTearoffMenu(interp, menuPtr, x, y);
  774.         }
  775.     } else if ((c == 'p') && (strncmp(argv[1], "postcascade", length) == 0)
  776.         && (length > 4)) {
  777.     int index;
  778.     if (argc != 3) {
  779.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  780.             argv[0], " postcascade index\"", (char *) NULL);
  781.         goto error;
  782.     }
  783.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
  784.         goto error;
  785.     }
  786.     if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) {
  787.         result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
  788.     } else {
  789.         result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]);
  790.     }
  791.     } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {
  792.     int index;
  793.     if (argc != 3) {
  794.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  795.             argv[0], " type index\"", (char *) NULL);
  796.         goto error;
  797.     }
  798.     if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
  799.         goto error;
  800.     }
  801.     if (index < 0) {
  802.         goto done;
  803.     }
  804.     mePtr = menuPtr->entries[index];
  805.     switch (mePtr->type) {
  806.         case COMMAND_ENTRY:
  807.         interp->result = "command";
  808.         break;
  809.         case SEPARATOR_ENTRY:
  810.         interp->result = "separator";
  811.         break;
  812.         case CHECK_BUTTON_ENTRY:
  813.         interp->result = "checkbutton";
  814.         break;
  815.         case RADIO_BUTTON_ENTRY:
  816.         interp->result = "radiobutton";
  817.         break;
  818.         case CASCADE_ENTRY:
  819.         interp->result = "cascade";
  820.         break;
  821.         case TEAROFF_ENTRY:
  822.         interp->result = "tearoff";
  823.         break;
  824.     }
  825.     } else if ((c == 'u') && (strncmp(argv[1], "unpost", length) == 0)) {
  826.     if (argc != 2) {
  827.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  828.             argv[0], " unpost\"", (char *) NULL);
  829.         goto error;
  830.     }
  831.     Tk_UnmapWindow(menuPtr->tkwin);
  832.     result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
  833.     } else if ((c == 'y') && (strncmp(argv[1], "yposition", length) == 0)) {
  834.     if (argc != 3) {
  835.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  836.             argv[0], " yposition index\"", (char *) NULL);
  837.         goto error;
  838.     }
  839.     result = MenuDoYPosition(interp, menuPtr, argv[2]);
  840.     } else {
  841.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  842.         "\": must be activate, add, cget, clone, configure, delete, ",
  843.         "entrycget, entryconfigure, index, insert, invoke, ",
  844.         "post, postcascade, type, unpost, or yposition",
  845.         (char *) NULL);
  846.     goto error;
  847.     }
  848.     done:
  849.     Tcl_Release((ClientData) menuPtr);
  850.     return result;
  851.  
  852.     error:
  853.     Tcl_Release((ClientData) menuPtr);
  854.     return TCL_ERROR;
  855. }
  856.  
  857.  
  858. /*
  859.  *----------------------------------------------------------------------
  860.  *
  861.  * TkInvokeMenu --
  862.  *
  863.  *    Given a menu and an index, takes the appropriate action for the
  864.  *    entry associated with that index.
  865.  *
  866.  * Results:
  867.  *    Standard Tcl result.
  868.  *
  869.  * Side effects:
  870.  *    Commands may get excecuted; variables may get set; sub-menus may
  871.  *    get posted.
  872.  *
  873.  *----------------------------------------------------------------------
  874.  */
  875.  
  876. int
  877. TkInvokeMenu(interp, menuPtr, index)
  878.     Tcl_Interp *interp;        /* The interp that the menu lives in. */
  879.     TkMenu *menuPtr;        /* The menu we are invoking. */
  880.     int index;            /* The zero based index of the item we
  881.                      * are invoking */
  882. {
  883.     int result = TCL_OK;
  884.     TkMenuEntry *mePtr;
  885.     
  886.     if (index < 0) {
  887.         goto done;
  888.     }
  889.     mePtr = menuPtr->entries[index];
  890.     if (mePtr->state == tkDisabledUid) {
  891.     goto done;
  892.     }
  893.     Tcl_Preserve((ClientData) mePtr);
  894.     if (mePtr->type == TEAROFF_ENTRY) {
  895.         Tcl_DString commandDString;
  896.         
  897.         Tcl_DStringInit(&commandDString);
  898.         Tcl_DStringAppendElement(&commandDString, "tkTearOffMenu");
  899.         Tcl_DStringAppendElement(&commandDString, Tk_PathName(menuPtr->tkwin));
  900.         result = Tcl_Eval(interp, Tcl_DStringValue(&commandDString));
  901.         Tcl_DStringFree(&commandDString);
  902.     } else if (mePtr->type == CHECK_BUTTON_ENTRY) {
  903.     if (mePtr->entryFlags & ENTRY_SELECTED) {
  904.         if (Tcl_SetVar(interp, mePtr->name, mePtr->offValue,
  905.             TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
  906.         result = TCL_ERROR;
  907.         }
  908.     } else {
  909.         if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
  910.             TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
  911.         result = TCL_ERROR;
  912.         }
  913.     }
  914.     } else if (mePtr->type == RADIO_BUTTON_ENTRY) {
  915.     if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
  916.         TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
  917.         result = TCL_ERROR;
  918.     }
  919.     }
  920.     if ((result == TCL_OK) && (mePtr->command != NULL)) {
  921.     result = TkCopyAndGlobalEval(interp, mePtr->command);
  922.     }
  923.     Tcl_Release((ClientData) mePtr);
  924.     done:
  925.     return result; 
  926. }
  927.  
  928.  
  929.  
  930. /*
  931.  *----------------------------------------------------------------------
  932.  *
  933.  * DestroyMenuInstance --
  934.  *
  935.  *    This procedure is invoked by TkDestroyMenu
  936.  *    to clean up the internal structure of a menu at a safe time
  937.  *    (when no-one is using it anymore). Only takes care of one instance
  938.  *    of the menu.
  939.  *
  940.  * Results:
  941.  *    None.
  942.  *
  943.  * Side effects:
  944.  *    Everything associated with the menu is freed up.
  945.  *
  946.  *----------------------------------------------------------------------
  947.  */
  948.  
  949. static void
  950. DestroyMenuInstance(menuPtr)
  951.     TkMenu *menuPtr;    /* Info about menu widget. */
  952. {
  953.     int i, numEntries = menuPtr->numEntries;
  954.     TkMenu *menuInstancePtr;
  955.     TkMenuEntry *cascadePtr, *nextCascadePtr;
  956.     char *newArgv[2];
  957.     TkMenu *parentMasterMenuPtr;
  958.     TkMenuEntry *parentMasterEntryPtr;
  959.     TkMenu *parentMenuPtr;
  960.     
  961.     /*
  962.      * If the menu has any cascade menu entries pointing to it, the cascade
  963.      * entries need to be told that the menu is going away. We need to clear
  964.      * the menu ptr field in the menu reference at this point in the code
  965.      * so that everything else can forget about this menu properly. We also
  966.      * need to reset -menu field of all entries that are not master menus
  967.      * back to this entry name if this is a master menu pointed to by another
  968.      * master menu. If there is a clone menu that points to this menu,
  969.      * then this menu is itself a clone, so when this menu goes away,
  970.      * the -menu field of the pointing entry must be set back to this
  971.      * menu's master menu name so that later if another menu is created
  972.      * the cascade hierarchy can be maintained.
  973.      */
  974.  
  975.     TkpDestroyMenu(menuPtr);
  976.     cascadePtr = menuPtr->menuRefPtr->parentEntryPtr;
  977.     menuPtr->menuRefPtr->menuPtr = NULL;
  978.     TkFreeMenuReferences(menuPtr->menuRefPtr);
  979.  
  980.     for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {
  981.         parentMenuPtr = cascadePtr->menuPtr;
  982.         nextCascadePtr = cascadePtr->nextCascadePtr;
  983.         
  984.         if (menuPtr->masterMenuPtr != menuPtr) {
  985.         parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
  986.         if (parentMenuPtr->tearOff && !parentMasterMenuPtr->tearOff) {
  987.             parentMasterEntryPtr = 
  988.                        parentMasterMenuPtr->entries[cascadePtr->index - 1];
  989.         } else if (!parentMenuPtr->tearOff
  990.             && parentMasterMenuPtr->tearOff) {
  991.             parentMasterEntryPtr = 
  992.                        parentMasterMenuPtr->entries[cascadePtr->index + 1];
  993.         } else {
  994.             parentMasterEntryPtr =
  995.                       parentMasterMenuPtr->entries[cascadePtr->index];
  996.         }
  997.         newArgv[0] = "-menu";
  998.         newArgv[1] = parentMasterEntryPtr->name;
  999.             ConfigureMenuEntry(cascadePtr, 2, newArgv, TK_CONFIG_ARGV_ONLY);
  1000.         } else {
  1001.             ConfigureMenuEntry(cascadePtr, 0, (char **) NULL, 0);
  1002.         }
  1003.     }
  1004.     
  1005.     if (menuPtr->masterMenuPtr != menuPtr) {
  1006.         for (menuInstancePtr = menuPtr->masterMenuPtr; 
  1007.             menuInstancePtr != NULL;
  1008.             menuInstancePtr = menuInstancePtr->nextInstancePtr) {
  1009.             if (menuInstancePtr->nextInstancePtr == menuPtr) {
  1010.                 menuInstancePtr->nextInstancePtr = 
  1011.                     menuInstancePtr->nextInstancePtr->nextInstancePtr;
  1012.                 break;
  1013.             }
  1014.         }
  1015.    } else if (menuPtr->nextInstancePtr != NULL) {
  1016.        panic("Attempting to delete master menu when there are still clones.");
  1017.    }
  1018.  
  1019.     /*
  1020.      * Free up all the stuff that requires special handling, then
  1021.      * let Tk_FreeOptions handle all the standard option-related
  1022.      * stuff.
  1023.      */
  1024.  
  1025.     for (i = numEntries - 1; i >= 0; i--) {
  1026.     DestroyMenuEntry((char *) menuPtr->entries[menuPtr->numEntries - 1]);
  1027.     }
  1028.     if (menuPtr->entries != NULL) {
  1029.     ckfree((char *) menuPtr->entries);
  1030.     }
  1031.     TkMenuFreeDrawOptions(menuPtr);
  1032.     Tk_FreeOptions(tkMenuConfigSpecs, (char *) menuPtr, menuPtr->display, 0);
  1033.  
  1034.     Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
  1035. }
  1036.  
  1037. /*
  1038.  *----------------------------------------------------------------------
  1039.  *
  1040.  * TkDestroyMenu --
  1041.  *
  1042.  *    This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
  1043.  *    to clean up the internal structure of a menu at a safe time
  1044.  *    (when no-one is using it anymore).  If called on a master instance,
  1045.  *    destroys all of the slave instances. If called on a non-master
  1046.  *    instance, just destroys that instance.
  1047.  *
  1048.  * Results:
  1049.  *    None.
  1050.  *
  1051.  * Side effects:
  1052.  *    Everything associated with the menu is freed up.
  1053.  *
  1054.  *----------------------------------------------------------------------
  1055.  */
  1056.  
  1057. void
  1058. TkDestroyMenu(menuPtr)
  1059.     TkMenu *menuPtr;    /* Info about menu widget. */
  1060. {
  1061.     TkMenu *menuInstancePtr;
  1062.     TkMenuTopLevelList *topLevelListPtr, *nextTopLevelPtr;
  1063.  
  1064.     if (menuPtr->menuFlags & MENU_DELETION_PENDING) {
  1065.         return;
  1066.     }
  1067.     
  1068.     /*
  1069.      * Now destroy all non-tearoff instances of this menu if this is a 
  1070.      * parent menu. Is this loop safe enough? Are there going to be
  1071.      * destroy bindings on child menus which kill the parent? If not,
  1072.      * we have to do a slightly more complex scheme.
  1073.      */
  1074.     
  1075.     if (menuPtr->masterMenuPtr == menuPtr) {
  1076.         menuPtr->menuFlags |= MENU_DELETION_PENDING;
  1077.     while (menuPtr->nextInstancePtr != NULL) {
  1078.         menuInstancePtr = menuPtr->nextInstancePtr;
  1079.         menuPtr->nextInstancePtr = menuInstancePtr->nextInstancePtr;
  1080.             if (menuInstancePtr->tkwin != NULL) {
  1081.              Tk_DestroyWindow(menuInstancePtr->tkwin);
  1082.         }
  1083.     }
  1084.         menuPtr->menuFlags &= ~MENU_DELETION_PENDING;
  1085.     }
  1086.  
  1087.     /*
  1088.      * If any toplevel widgets have this menu as their menubar,
  1089.      * the geometry of the window may have to be recalculated.
  1090.      */
  1091.     
  1092.     topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr;
  1093.     while (topLevelListPtr != NULL) {
  1094.          nextTopLevelPtr = topLevelListPtr->nextPtr;
  1095.          TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL);
  1096.          topLevelListPtr = nextTopLevelPtr;
  1097.     }   
  1098.     DestroyMenuInstance(menuPtr);
  1099. }
  1100.  
  1101. /*
  1102.  *----------------------------------------------------------------------
  1103.  *
  1104.  * UnhookCascadeEntry --
  1105.  *
  1106.  *    This entry is removed from the list of entries that point to the
  1107.  *    cascade menu. This is done in preparation for changing the menu
  1108.  *    that this entry points to.
  1109.  *
  1110.  * Results:
  1111.  *    None
  1112.  *
  1113.  * Side effects:
  1114.  *    The appropriate lists are modified.
  1115.  *
  1116.  *----------------------------------------------------------------------
  1117.  */
  1118.  
  1119. static void
  1120. UnhookCascadeEntry(mePtr)
  1121.     TkMenuEntry *mePtr;            /* The cascade entry we are removing
  1122.                      * from the cascade list. */
  1123. {
  1124.     TkMenuEntry *cascadeEntryPtr;
  1125.     TkMenuEntry *prevCascadePtr;
  1126.     TkMenuReferences *menuRefPtr;
  1127.  
  1128.     menuRefPtr = mePtr->childMenuRefPtr;
  1129.     if (menuRefPtr == NULL) {
  1130.         return;
  1131.     }
  1132.     
  1133.     cascadeEntryPtr = menuRefPtr->parentEntryPtr;
  1134.     if (cascadeEntryPtr == NULL) {
  1135.         return;
  1136.     }
  1137.     
  1138.     /*
  1139.      * Singularly linked list deletion. The two special cases are
  1140.      * 1. one element; 2. The first element is the one we want.
  1141.      */
  1142.  
  1143.     if (cascadeEntryPtr == mePtr) {
  1144.         if (cascadeEntryPtr->nextCascadePtr == NULL) {
  1145.  
  1146.         /*
  1147.          * This is the last menu entry which points to this
  1148.          * menu, so we need to clear out the list pointer in the
  1149.          * cascade itself.
  1150.          */
  1151.     
  1152.         menuRefPtr->parentEntryPtr = NULL;
  1153.         TkFreeMenuReferences(menuRefPtr);
  1154.         } else {
  1155.             menuRefPtr->parentEntryPtr = cascadeEntryPtr->nextCascadePtr;
  1156.         }
  1157.         mePtr->nextCascadePtr = NULL;
  1158.     } else {
  1159.     for (prevCascadePtr = cascadeEntryPtr,
  1160.         cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr;
  1161.         cascadeEntryPtr != NULL;
  1162.             prevCascadePtr = cascadeEntryPtr,
  1163.         cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
  1164.             if (cascadeEntryPtr == mePtr){
  1165.                 prevCascadePtr->nextCascadePtr =
  1166.                         cascadeEntryPtr->nextCascadePtr;
  1167.                 cascadeEntryPtr->nextCascadePtr = NULL;
  1168.                 break;
  1169.             }
  1170.         }
  1171.     }
  1172.     mePtr->childMenuRefPtr = NULL;
  1173. }
  1174.  
  1175. /*
  1176.  *----------------------------------------------------------------------
  1177.  *
  1178.  * DestroyMenuEntry --
  1179.  *
  1180.  *    This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
  1181.  *    to clean up the internal structure of a menu entry at a safe time
  1182.  *    (when no-one is using it anymore).
  1183.  *
  1184.  * Results:
  1185.  *    None.
  1186.  *
  1187.  * Side effects:
  1188.  *    Everything associated with the menu entry is freed.
  1189.  *
  1190.  *----------------------------------------------------------------------
  1191.  */
  1192.  
  1193. static void
  1194. DestroyMenuEntry(memPtr)
  1195.     char *memPtr;        /* Pointer to entry to be freed. */
  1196. {
  1197.     register TkMenuEntry *mePtr = (TkMenuEntry *) memPtr;
  1198.     TkMenu *menuPtr = mePtr->menuPtr;
  1199.     int i, index = mePtr->index;
  1200.  
  1201.     if (menuPtr->postedCascade == mePtr) {
  1202.     
  1203.         /*
  1204.      * Ignore errors while unposting the menu, since it's possible
  1205.      * that the menu has already been deleted and the unpost will
  1206.      * generate an error.
  1207.      */
  1208.  
  1209.     TkPostSubmenu(menuPtr->interp, menuPtr, (TkMenuEntry *) NULL);
  1210.     }
  1211.  
  1212.     /*
  1213.      * Free up all the stuff that requires special handling, then
  1214.      * let Tk_FreeOptions handle all the standard option-related
  1215.      * stuff.
  1216.      */
  1217.  
  1218.     if (mePtr->type == CASCADE_ENTRY) {
  1219.         UnhookCascadeEntry(mePtr);
  1220.     }
  1221.     if (mePtr->image != NULL) {
  1222.     Tk_FreeImage(mePtr->image);
  1223.     }
  1224.     if (mePtr->selectImage != NULL) {
  1225.     Tk_FreeImage(mePtr->selectImage);
  1226.     }
  1227.     if (mePtr->name != NULL) {
  1228.     Tcl_UntraceVar(menuPtr->interp, mePtr->name,
  1229.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  1230.         MenuVarProc, (ClientData) mePtr);
  1231.     }
  1232.     for (i = index; i < menuPtr->numEntries - 1; i++) {
  1233.         menuPtr->entries[i] = menuPtr->entries[i + 1];
  1234.         menuPtr->entries[i]->index = i;
  1235.     }
  1236.     menuPtr->numEntries--;
  1237.     if (menuPtr->numEntries == 0) {
  1238.         ckfree((char *) menuPtr->entries);
  1239.         menuPtr->entries = NULL;
  1240.     }
  1241.     TkpDestroyMenuEntry(mePtr);
  1242.     TkMenuEntryFreeDrawOptions(mePtr);
  1243.     Tk_FreeOptions(tkMenuEntryConfigSpecs, (char *) mePtr, menuPtr->display, 
  1244.         (COMMAND_MASK << mePtr->type));
  1245.     ckfree((char *) mePtr);
  1246. }
  1247.  
  1248. /*
  1249.  *---------------------------------------------------------------------------
  1250.  *
  1251.  * MenuWorldChanged --
  1252.  *
  1253.  *      This procedure is called when the world has changed in some
  1254.  *      way (such as the fonts in the system changing) and the widget needs
  1255.  *    to recompute all its graphics contexts and determine its new geometry.
  1256.  *
  1257.  * Results:
  1258.  *      None.
  1259.  *
  1260.  * Side effects:
  1261.  *      Menu will be relayed out and redisplayed.
  1262.  *
  1263.  *---------------------------------------------------------------------------
  1264.  */
  1265.  
  1266. static void
  1267. MenuWorldChanged(instanceData)
  1268.     ClientData instanceData;    /* Information about widget. */
  1269. {
  1270.     TkMenu *menuPtr = (TkMenu *) instanceData;
  1271.     int i;
  1272.     
  1273.     TkMenuConfigureDrawOptions(menuPtr);
  1274.     for (i = 0; i < menuPtr->numEntries; i++) {
  1275.         TkMenuConfigureEntryDrawOptions(menuPtr->entries[i],
  1276.         menuPtr->entries[i]->index);
  1277.     TkpConfigureMenuEntry(menuPtr->entries[i]);    
  1278.     }
  1279. }
  1280.  
  1281.  
  1282. /*
  1283.  *----------------------------------------------------------------------
  1284.  *
  1285.  * ConfigureMenu --
  1286.  *
  1287.  *    This procedure is called to process an argv/argc list, plus
  1288.  *    the Tk option database, in order to configure (or
  1289.  *    reconfigure) a menu widget.
  1290.  *
  1291.  * Results:
  1292.  *    The return value is a standard Tcl result.  If TCL_ERROR is
  1293.  *    returned, then interp->result contains an error message.
  1294.  *
  1295.  * Side effects:
  1296.  *    Configuration information, such as colors, font, etc. get set
  1297.  *    for menuPtr;  old resources get freed, if there were any.
  1298.  *
  1299.  *----------------------------------------------------------------------
  1300.  */
  1301.  
  1302. static int
  1303. ConfigureMenu(interp, menuPtr, argc, argv, flags)
  1304.     Tcl_Interp *interp;        /* Used for error reporting. */
  1305.     register TkMenu *menuPtr;    /* Information about widget;  may or may
  1306.                  * not already have values for some fields. */
  1307.     int argc;            /* Number of valid entries in argv. */
  1308.     char **argv;        /* Arguments. */
  1309.     int flags;            /* Flags to pass to Tk_ConfigureWidget. */
  1310. {
  1311.     int i;
  1312.     TkMenu* menuListPtr;
  1313.     
  1314.     for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
  1315.         menuListPtr = menuListPtr->nextInstancePtr) {
  1316.     
  1317.     if (Tk_ConfigureWidget(interp, menuListPtr->tkwin,
  1318.         tkMenuConfigSpecs, argc, argv, (char *) menuListPtr,
  1319.         flags) != TCL_OK) {
  1320.         return TCL_ERROR;
  1321.     }
  1322.  
  1323.     /*
  1324.      * When a menu is created, the type is in all of the arguments
  1325.      * to the menu command. Let Tk_ConfigureWidget take care of
  1326.      * parsing them, and then set the type after we can look at
  1327.      * the type string. Once set, a menu's type cannot be changed
  1328.      */
  1329.     
  1330.     if (menuPtr->menuType == UNKNOWN_TYPE) {
  1331.         if (strcmp(menuPtr->menuTypeName, "menubar") == 0) {
  1332.             menuPtr->menuType = MENUBAR;
  1333.         } else if (strcmp(menuPtr->menuTypeName, "tearoff") == 0) {
  1334.             menuPtr->menuType = TEAROFF_MENU;
  1335.         } else {
  1336.             menuPtr->menuType = MASTER_MENU;
  1337.         }
  1338.     }
  1339.     
  1340.     /*
  1341.      * Depending on the -tearOff option, make sure that there is or
  1342.      * isn't an initial tear-off entry at the beginning of the menu.
  1343.      */
  1344.     
  1345.     if (menuListPtr->tearOff) {
  1346.         if ((menuListPtr->numEntries == 0)
  1347.             || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
  1348.         if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
  1349.             return TCL_ERROR;
  1350.         }
  1351.         }
  1352.     } else if ((menuListPtr->numEntries > 0)
  1353.         && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
  1354.         Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
  1355.                 DestroyMenuEntry);
  1356.     }
  1357.  
  1358.     TkMenuConfigureDrawOptions(menuListPtr);
  1359.  
  1360.     /*
  1361.      * Configure the new window to be either a pop-up menu
  1362.      * or a tear-off menu.
  1363.      * We don't do this for menubars since they are not toplevel
  1364.      * windows. Also, since this gets called before CloneMenu has
  1365.      * a chance to set the menuType field, we have to look at the
  1366.      * menuTypeName field to tell that this is a menu bar.
  1367.      */
  1368.     
  1369.     if (strcmp(menuListPtr->menuTypeName, "normal") == 0) {
  1370.         TkMakeMenuWindow(menuListPtr->tkwin, 1);
  1371.     } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
  1372.         TkMakeMenuWindow(menuListPtr->tkwin, 0);
  1373.     }
  1374.     
  1375.     /*
  1376.      * After reconfiguring a menu, we need to reconfigure all of the
  1377.      * entries in the menu, since some of the things in the children
  1378.      * (such as graphics contexts) may have to change to reflect changes
  1379.      * in the parent.
  1380.      */
  1381.     
  1382.     for (i = 0; i < menuListPtr->numEntries; i++) {
  1383.         TkMenuEntry *mePtr;
  1384.     
  1385.         mePtr = menuListPtr->entries[i];
  1386.         ConfigureMenuEntry(mePtr, 0,
  1387.                 (char **) NULL, TK_CONFIG_ARGV_ONLY 
  1388.                 | COMMAND_MASK << mePtr->type);
  1389.     }
  1390.     
  1391.     TkEventuallyRecomputeMenu(menuListPtr);
  1392.     }
  1393.  
  1394.     return TCL_OK;
  1395. }
  1396.  
  1397. /*
  1398.  *----------------------------------------------------------------------
  1399.  *
  1400.  * ConfigureMenuEntry --
  1401.  *
  1402.  *    This procedure is called to process an argv/argc list in order
  1403.  *    to configure (or reconfigure) one entry in a menu.
  1404.  *
  1405.  * Results:
  1406.  *    The return value is a standard Tcl result.  If TCL_ERROR is
  1407.  *    returned, then interp->result contains an error message.
  1408.  *
  1409.  * Side effects:
  1410.  *    Configuration information such as label and accelerator get
  1411.  *    set for mePtr;  old resources get freed, if there were any.
  1412.  *
  1413.  *----------------------------------------------------------------------
  1414.  */
  1415.  
  1416. static int
  1417. ConfigureMenuEntry(mePtr, argc, argv, flags)
  1418.     register TkMenuEntry *mePtr;        /* Information about menu entry;  may
  1419.                      * or may not already have values for
  1420.                      * some fields. */
  1421.     int argc;                /* Number of valid entries in argv. */
  1422.     char **argv;            /* Arguments. */
  1423.     int flags;                /* Additional flags to pass to
  1424.                      * Tk_ConfigureWidget. */
  1425. {
  1426.     TkMenu *menuPtr = mePtr->menuPtr;
  1427.     int index = mePtr->index;
  1428.     Tk_Image image;
  1429.  
  1430.     /*
  1431.      * If this entry is a check button or radio button, then remove
  1432.      * its old trace procedure.
  1433.      */
  1434.  
  1435.     if ((mePtr->name != NULL)
  1436.             && ((mePtr->type == CHECK_BUTTON_ENTRY)
  1437.         || (mePtr->type == RADIO_BUTTON_ENTRY))) {
  1438.     Tcl_UntraceVar(menuPtr->interp, mePtr->name,
  1439.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  1440.         MenuVarProc, (ClientData) mePtr);
  1441.     }
  1442.     
  1443.     if (menuPtr->tkwin != NULL) {
  1444.     if (Tk_ConfigureWidget(menuPtr->interp, menuPtr->tkwin, 
  1445.         tkMenuEntryConfigSpecs, argc, argv, (char *) mePtr,
  1446.         flags | (COMMAND_MASK << mePtr->type)) != TCL_OK) {
  1447.         return TCL_ERROR;
  1448.     }
  1449.     }
  1450.  
  1451.     /*
  1452.      * The code below handles special configuration stuff not taken
  1453.      * care of by Tk_ConfigureWidget, such as special processing for
  1454.      * defaults, sizing strings, graphics contexts, etc.
  1455.      */
  1456.  
  1457.     if (mePtr->label == NULL) {
  1458.     mePtr->labelLength = 0;
  1459.     } else {
  1460.     mePtr->labelLength = strlen(mePtr->label);
  1461.     }
  1462.     if (mePtr->accel == NULL) {
  1463.     mePtr->accelLength = 0;
  1464.     } else {
  1465.     mePtr->accelLength = strlen(mePtr->accel);
  1466.     }
  1467.  
  1468.     /*
  1469.      * If this is a cascade entry, the platform-specific data of the child
  1470.      * menu has to be updated. Also, the links that point to parents and
  1471.      * cascades have to be updated.
  1472.      */
  1473.  
  1474.     if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) {
  1475.      TkMenuEntry *cascadeEntryPtr;
  1476.      TkMenu *cascadeMenuPtr;
  1477.     int alreadyThere;
  1478.     TkMenuReferences *menuRefPtr;
  1479.     char *oldHashKey = NULL;    /* Initialization only needed to
  1480.                      * prevent compiler warning. */
  1481.  
  1482.     /*
  1483.      * This is a cascade entry. If the menu that the cascade entry
  1484.      * is pointing to has changed, we need to remove this entry
  1485.      * from the list of entries pointing to the old menu, and add a
  1486.      * cascade reference to the list of entries pointing to the
  1487.      * new menu.
  1488.      *
  1489.      * BUG: We are not recloning for special case #3 yet.
  1490.      */
  1491.     
  1492.     if (mePtr->childMenuRefPtr != NULL) {
  1493.         oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
  1494.             mePtr->childMenuRefPtr->hashEntryPtr);
  1495.         if (strcmp(oldHashKey, mePtr->name) != 0) {
  1496.         UnhookCascadeEntry(mePtr);
  1497.         }
  1498.     }
  1499.  
  1500.     if ((mePtr->childMenuRefPtr == NULL) 
  1501.         || (strcmp(oldHashKey, mePtr->name) != 0)) {
  1502.         menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
  1503.             mePtr->name);
  1504.         cascadeMenuPtr = menuRefPtr->menuPtr;
  1505.         mePtr->childMenuRefPtr = menuRefPtr;
  1506.  
  1507.         if (menuRefPtr->parentEntryPtr == NULL) {
  1508.         menuRefPtr->parentEntryPtr = mePtr;
  1509.         } else {
  1510.         alreadyThere = 0;
  1511.         for (cascadeEntryPtr = menuRefPtr->parentEntryPtr;
  1512.             cascadeEntryPtr != NULL;
  1513.             cascadeEntryPtr =
  1514.             cascadeEntryPtr->nextCascadePtr) {
  1515.             if (cascadeEntryPtr == mePtr) {
  1516.             alreadyThere = 1;
  1517.             break;
  1518.             }
  1519.         }
  1520.     
  1521.         /*
  1522.          * Put the item at the front of the list.
  1523.          */
  1524.         
  1525.         if (!alreadyThere) {
  1526.             mePtr->nextCascadePtr = menuRefPtr->parentEntryPtr;
  1527.             menuRefPtr->parentEntryPtr = mePtr;
  1528.         }
  1529.         }
  1530.     }
  1531.     }
  1532.     
  1533.     if (TkMenuConfigureEntryDrawOptions(mePtr, index) != TCL_OK) {
  1534.         return TCL_ERROR;
  1535.     }
  1536.  
  1537.     if (TkpConfigureMenuEntry(mePtr) != TCL_OK) {
  1538.         return TCL_ERROR;
  1539.     }
  1540.     
  1541.     if ((mePtr->type == CHECK_BUTTON_ENTRY)
  1542.         || (mePtr->type == RADIO_BUTTON_ENTRY)) {
  1543.     char *value;
  1544.  
  1545.     if (mePtr->name == NULL) {
  1546.         mePtr->name =
  1547.             (char *) ckalloc((unsigned) (mePtr->labelLength + 1));
  1548.         strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label);
  1549.     }
  1550.     if (mePtr->onValue == NULL) {
  1551.         mePtr->onValue = (char *) ckalloc((unsigned)
  1552.             (mePtr->labelLength + 1));
  1553.         strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label);
  1554.     }
  1555.  
  1556.     /*
  1557.      * Select the entry if the associated variable has the
  1558.      * appropriate value, initialize the variable if it doesn't
  1559.      * exist, then set a trace on the variable to monitor future
  1560.      * changes to its value.
  1561.      */
  1562.  
  1563.     value = Tcl_GetVar(menuPtr->interp, mePtr->name, TCL_GLOBAL_ONLY);
  1564.     mePtr->entryFlags &= ~ENTRY_SELECTED;
  1565.     if (value != NULL) {
  1566.         if (strcmp(value, mePtr->onValue) == 0) {
  1567.         mePtr->entryFlags |= ENTRY_SELECTED;
  1568.         }
  1569.     } else {
  1570.         Tcl_SetVar(menuPtr->interp, mePtr->name,
  1571.             (mePtr->type == CHECK_BUTTON_ENTRY) ? mePtr->offValue : "",
  1572.             TCL_GLOBAL_ONLY);
  1573.     }
  1574.     Tcl_TraceVar(menuPtr->interp, mePtr->name,
  1575.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  1576.         MenuVarProc, (ClientData) mePtr);
  1577.     }
  1578.  
  1579.     /*
  1580.      * Get the images for the entry, if there are any.  Allocate the
  1581.      * new images before freeing the old ones, so that the reference
  1582.      * counts don't go to zero and cause image data to be discarded.
  1583.      */
  1584.  
  1585.     if (mePtr->imageString != NULL) {
  1586.     image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->imageString,
  1587.         TkMenuImageProc, (ClientData) mePtr);
  1588.     if (image == NULL) {
  1589.         return TCL_ERROR;
  1590.     }
  1591.     } else {
  1592.     image = NULL;
  1593.     }
  1594.     if (mePtr->image != NULL) {
  1595.     Tk_FreeImage(mePtr->image);
  1596.     }
  1597.     mePtr->image = image;
  1598.     if (mePtr->selectImageString != NULL) {
  1599.     image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->selectImageString,
  1600.         TkMenuSelectImageProc, (ClientData) mePtr);
  1601.     if (image == NULL) {
  1602.         return TCL_ERROR;
  1603.     }
  1604.     } else {
  1605.     image = NULL;
  1606.     }
  1607.     if (mePtr->selectImage != NULL) {
  1608.     Tk_FreeImage(mePtr->selectImage);
  1609.     }
  1610.     mePtr->selectImage = image;
  1611.  
  1612.     TkEventuallyRecomputeMenu(menuPtr);
  1613.     
  1614.     return TCL_OK;
  1615. }
  1616.  
  1617. /*
  1618.  *----------------------------------------------------------------------
  1619.  *
  1620.  * ConfigureMenuCloneEntries --
  1621.  *
  1622.  *    Calls ConfigureMenuEntry for each menu in the clone chain.
  1623.  *
  1624.  * Results:
  1625.  *    The return value is a standard Tcl result.  If TCL_ERROR is
  1626.  *    returned, then interp->result contains an error message.
  1627.  *
  1628.  * Side effects:
  1629.  *    Configuration information such as label and accelerator get
  1630.  *    set for mePtr;  old resources get freed, if there were any.
  1631.  *
  1632.  *----------------------------------------------------------------------
  1633.  */
  1634.  
  1635. static int
  1636. ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
  1637.     Tcl_Interp *interp;            /* Used for error reporting. */
  1638.     TkMenu *menuPtr;            /* Information about whole menu. */
  1639.     int index;                /* Index of mePtr within menuPtr's
  1640.                      * entries. */
  1641.     int argc;                /* Number of valid entries in argv. */
  1642.     char **argv;            /* Arguments. */
  1643.     int flags;                /* Additional flags to pass to
  1644.                      * Tk_ConfigureWidget. */
  1645. {
  1646.     TkMenuEntry *mePtr;
  1647.     TkMenu *menuListPtr;
  1648.     char *oldCascadeName = NULL, *newMenuName = NULL;
  1649.     int cascadeEntryChanged;
  1650.     TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL; 
  1651.     
  1652.     /*
  1653.      * Cascades are kind of tricky here. This is special case #3 in the comment
  1654.      * at the top of this file. Basically, if a menu is the master menu of a
  1655.      * clone chain, and has an entry with a cascade menu, the clones of
  1656.      * the menu will point to clones of the cascade menu. We have
  1657.      * to destroy the clones of the cascades, clone the new cascade
  1658.      * menu, and configure the entry to point to the new clone.
  1659.      */
  1660.  
  1661.     mePtr = menuPtr->masterMenuPtr->entries[index];
  1662.     if (mePtr->type == CASCADE_ENTRY) {
  1663.     oldCascadeName = mePtr->name;
  1664.     }
  1665.  
  1666.     if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
  1667.     return TCL_ERROR;
  1668.     }
  1669.  
  1670.     cascadeEntryChanged = (mePtr->type == CASCADE_ENTRY)
  1671.         && (oldCascadeName != mePtr->name);
  1672.  
  1673.     if (cascadeEntryChanged) {
  1674.     newMenuName = mePtr->name;
  1675.     if (newMenuName != NULL) {
  1676.         cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
  1677.             mePtr->name);
  1678.     }
  1679.     }
  1680.  
  1681.     for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr; 
  1682.             menuListPtr != NULL;
  1683.         menuListPtr = menuListPtr->nextInstancePtr) {
  1684.       
  1685.         mePtr = menuListPtr->entries[index];
  1686.  
  1687.     if (cascadeEntryChanged && (mePtr->name != NULL)) {
  1688.         oldCascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp, 
  1689.             mePtr->name);
  1690.  
  1691.         if ((oldCascadeMenuRefPtr != NULL)
  1692.             && (oldCascadeMenuRefPtr->menuPtr != NULL)) {
  1693.         RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr);
  1694.         }
  1695.     }
  1696.  
  1697.         if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
  1698.             return TCL_ERROR;
  1699.         }
  1700.     
  1701.     if (cascadeEntryChanged && (newMenuName != NULL)) {
  1702.         if (cascadeMenuRefPtr->menuPtr != NULL) {
  1703.         char *newArgV[2];
  1704.         char *newCloneName;
  1705.  
  1706.         newCloneName = TkNewMenuName(menuPtr->interp,
  1707.             Tk_PathName(menuListPtr->tkwin), 
  1708.             cascadeMenuRefPtr->menuPtr);
  1709.         CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneName,
  1710.             "normal");
  1711.  
  1712.         newArgV[0] = "-menu";
  1713.         newArgV[1] = newCloneName;
  1714.         ConfigureMenuEntry(mePtr, 2, newArgV, flags);
  1715.         ckfree(newCloneName);
  1716.         }
  1717.     }
  1718.     }
  1719.     return TCL_OK;
  1720. }
  1721.  
  1722. /*
  1723.  *--------------------------------------------------------------
  1724.  *
  1725.  * TkGetMenuIndex --
  1726.  *
  1727.  *    Parse a textual index into a menu and return the numerical
  1728.  *    index of the indicated entry.
  1729.  *
  1730.  * Results:
  1731.  *    A standard Tcl result.  If all went well, then *indexPtr is
  1732.  *    filled in with the entry index corresponding to string
  1733.  *    (ranges from -1 to the number of entries in the menu minus
  1734.  *    one).  Otherwise an error message is left in interp->result.
  1735.  *
  1736.  * Side effects:
  1737.  *    None.
  1738.  *
  1739.  *--------------------------------------------------------------
  1740.  */
  1741.  
  1742. int
  1743. TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr)
  1744.     Tcl_Interp *interp;        /* For error messages. */
  1745.     TkMenu *menuPtr;        /* Menu for which the index is being
  1746.                  * specified. */
  1747.     char *string;        /* Specification of an entry in menu.  See
  1748.                  * manual entry for valid .*/
  1749.     int lastOK;            /* Non-zero means its OK to return index
  1750.                  * just *after* last entry. */
  1751.     int *indexPtr;        /* Where to store converted relief. */
  1752. {
  1753.     int i;
  1754.  
  1755.     if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
  1756.     *indexPtr = menuPtr->active;
  1757.     return TCL_OK;
  1758.     }
  1759.  
  1760.     if (((string[0] == 'l') && (strcmp(string, "last") == 0))
  1761.         || ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
  1762.     *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
  1763.     return TCL_OK;
  1764.     }
  1765.  
  1766.     if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
  1767.     *indexPtr = -1;
  1768.     return TCL_OK;
  1769.     }
  1770.  
  1771.     if (string[0] == '@') {
  1772.     if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
  1773.         == TCL_OK) {
  1774.         return TCL_OK;
  1775.     }
  1776.     }
  1777.  
  1778.     if (isdigit(UCHAR(string[0]))) {
  1779.     if (Tcl_GetInt(interp, string,  &i) == TCL_OK) {
  1780.         if (i >= menuPtr->numEntries) {
  1781.         if (lastOK) {
  1782.             i = menuPtr->numEntries;
  1783.         } else {
  1784.             i = menuPtr->numEntries-1;
  1785.         }
  1786.         } else if (i < 0) {
  1787.         i = -1;
  1788.         }
  1789.         *indexPtr = i;
  1790.         return TCL_OK;
  1791.     }
  1792.     Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
  1793.     }
  1794.  
  1795.     for (i = 0; i < menuPtr->numEntries; i++) {
  1796.     char *label;
  1797.  
  1798.     label = menuPtr->entries[i]->label;
  1799.     if ((label != NULL)
  1800.         && (Tcl_StringMatch(menuPtr->entries[i]->label, string))) {
  1801.         *indexPtr = i;
  1802.         return TCL_OK;
  1803.     }
  1804.     }
  1805.  
  1806.     Tcl_AppendResult(interp, "bad menu entry index \"",
  1807.         string, "\"", (char *) NULL);
  1808.     return TCL_ERROR;
  1809. }
  1810.  
  1811. /*
  1812.  *----------------------------------------------------------------------
  1813.  *
  1814.  * MenuCmdDeletedProc --
  1815.  *
  1816.  *    This procedure is invoked when a widget command is deleted.  If
  1817.  *    the widget isn't already in the process of being destroyed,
  1818.  *    this command destroys it.
  1819.  *
  1820.  * Results:
  1821.  *    None.
  1822.  *
  1823.  * Side effects:
  1824.  *    The widget is destroyed.
  1825.  *
  1826.  *----------------------------------------------------------------------
  1827.  */
  1828.  
  1829. static void
  1830. MenuCmdDeletedProc(clientData)
  1831.     ClientData clientData;    /* Pointer to widget record for widget. */
  1832. {
  1833.     TkMenu *menuPtr = (TkMenu *) clientData;
  1834.     Tk_Window tkwin = menuPtr->tkwin;
  1835.  
  1836.     /*
  1837.      * This procedure could be invoked either because the window was
  1838.      * destroyed and the command was then deleted (in which case tkwin
  1839.      * is NULL) or because the command was deleted, and then this procedure
  1840.      * destroys the widget.
  1841.      */
  1842.  
  1843.     if (tkwin != NULL) {
  1844.     menuPtr->tkwin = NULL;
  1845.     Tk_DestroyWindow(tkwin);
  1846.     }
  1847. }
  1848.  
  1849. /*
  1850.  *----------------------------------------------------------------------
  1851.  *
  1852.  * MenuNewEntry --
  1853.  *
  1854.  *    This procedure allocates and initializes a new menu entry.
  1855.  *
  1856.  * Results:
  1857.  *    The return value is a pointer to a new menu entry structure,
  1858.  *    which has been malloc-ed, initialized, and entered into the
  1859.  *    entry array for the  menu.
  1860.  *
  1861.  * Side effects:
  1862.  *    Storage gets allocated.
  1863.  *
  1864.  *----------------------------------------------------------------------
  1865.  */
  1866.  
  1867. static TkMenuEntry *
  1868. MenuNewEntry(menuPtr, index, type)
  1869.     TkMenu *menuPtr;        /* Menu that will hold the new entry. */
  1870.     int index;            /* Where in the menu the new entry is to
  1871.                  * go. */
  1872.     int type;            /* The type of the new entry. */
  1873. {
  1874.     TkMenuEntry *mePtr;
  1875.     TkMenuEntry **newEntries;
  1876.     int i;
  1877.  
  1878.     /*
  1879.      * Create a new array of entries with an empty slot for the
  1880.      * new entry.
  1881.      */
  1882.  
  1883.     newEntries = (TkMenuEntry **) ckalloc((unsigned)
  1884.         ((menuPtr->numEntries+1)*sizeof(TkMenuEntry *)));
  1885.     for (i = 0; i < index; i++) {
  1886.     newEntries[i] = menuPtr->entries[i];
  1887.     }
  1888.     for (  ; i < menuPtr->numEntries; i++) {
  1889.     newEntries[i+1] = menuPtr->entries[i];
  1890.     newEntries[i+1]->index = i + 1;
  1891.     }
  1892.     if (menuPtr->numEntries != 0) {
  1893.     ckfree((char *) menuPtr->entries);
  1894.     }
  1895.     menuPtr->entries = newEntries;
  1896.     menuPtr->numEntries++;
  1897.     mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry));
  1898.     menuPtr->entries[index] = mePtr;
  1899.     mePtr->type = type;
  1900.     mePtr->menuPtr = menuPtr;
  1901.     mePtr->label = NULL;
  1902.     mePtr->labelLength = 0;
  1903.     mePtr->underline = -1;
  1904.     mePtr->bitmap = None;
  1905.     mePtr->imageString = NULL;
  1906.     mePtr->image = NULL;
  1907.     mePtr->selectImageString  = NULL;
  1908.     mePtr->selectImage = NULL;
  1909.     mePtr->accel = NULL;
  1910.     mePtr->accelLength = 0;
  1911.     mePtr->state = tkNormalUid;
  1912.     mePtr->border = NULL;
  1913.     mePtr->fg = NULL;
  1914.     mePtr->activeBorder = NULL;
  1915.     mePtr->activeFg = NULL;
  1916.     mePtr->tkfont = NULL;
  1917.     mePtr->indicatorOn = 1;
  1918.     mePtr->indicatorFg = NULL;
  1919.     mePtr->columnBreak = 0;
  1920.     mePtr->hideMargin = 0;
  1921.     mePtr->command = NULL;
  1922.     mePtr->name = NULL;
  1923.     mePtr->childMenuRefPtr = NULL;
  1924.     mePtr->onValue = NULL;
  1925.     mePtr->offValue = NULL;
  1926.     mePtr->entryFlags = 0;
  1927.     mePtr->index = index;
  1928.     mePtr->nextCascadePtr = NULL;
  1929.     TkMenuInitializeEntryDrawingFields(mePtr);
  1930.     if (TkpMenuNewEntry(mePtr) != TCL_OK) {
  1931.         ckfree((char *) mePtr);
  1932.         return NULL;
  1933.     }
  1934.     
  1935.     return mePtr;
  1936. }
  1937.  
  1938. /*
  1939.  *----------------------------------------------------------------------
  1940.  *
  1941.  * MenuAddOrInsert --
  1942.  *
  1943.  *    This procedure does all of the work of the "add" and "insert"
  1944.  *    widget commands, allowing the code for these to be shared.
  1945.  *
  1946.  * Results:
  1947.  *    A standard Tcl return value.
  1948.  *
  1949.  * Side effects:
  1950.  *    A new menu entry is created in menuPtr.
  1951.  *
  1952.  *----------------------------------------------------------------------
  1953.  */
  1954.  
  1955. static int
  1956. MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
  1957.     Tcl_Interp *interp;            /* Used for error reporting. */
  1958.     TkMenu *menuPtr;            /* Widget in which to create new
  1959.                      * entry. */
  1960.     char *indexString;            /* String describing index at which
  1961.                      * to insert.  NULL means insert at
  1962.                      * end. */
  1963.     int argc;                /* Number of elements in argv. */
  1964.     char **argv;            /* Arguments to command:  first arg
  1965.                      * is type of entry, others are
  1966.                      * config options. */
  1967. {
  1968.     int c, type, index;
  1969.     size_t length;
  1970.     TkMenuEntry *mePtr;
  1971.     TkMenu *menuListPtr;
  1972.  
  1973.     if (indexString != NULL) {
  1974.     if (TkGetMenuIndex(interp, menuPtr, indexString, 1, &index)
  1975.         != TCL_OK) {
  1976.         return TCL_ERROR;
  1977.     }
  1978.     } else {
  1979.     index = menuPtr->numEntries;
  1980.     }
  1981.     if (index < 0) {
  1982.     Tcl_AppendResult(interp, "bad index \"", indexString, "\"",
  1983.          (char *) NULL);
  1984.     return TCL_ERROR;
  1985.     }
  1986.     if (menuPtr->tearOff && (index == 0)) {
  1987.     index = 1;
  1988.     }
  1989.  
  1990.     /*
  1991.      * Figure out the type of the new entry.
  1992.      */
  1993.  
  1994.     c = argv[0][0];
  1995.     length = strlen(argv[0]);
  1996.     if ((c == 'c') && (strncmp(argv[0], "cascade", length) == 0)
  1997.         && (length >= 2)) {
  1998.     type = CASCADE_ENTRY;
  1999.     } else if ((c == 'c') && (strncmp(argv[0], "checkbutton", length) == 0)
  2000.         && (length >= 2)) {
  2001.     type = CHECK_BUTTON_ENTRY;
  2002.     } else if ((c == 'c') && (strncmp(argv[0], "command", length) == 0)
  2003.         && (length >= 2)) {
  2004.     type = COMMAND_ENTRY;
  2005.     } else if ((c == 'r')
  2006.         && (strncmp(argv[0], "radiobutton", length) == 0)) {
  2007.     type = RADIO_BUTTON_ENTRY;
  2008.     } else if ((c == 's')
  2009.         && (strncmp(argv[0], "separator", length) == 0)) {
  2010.     type = SEPARATOR_ENTRY;
  2011.     } else {
  2012.     Tcl_AppendResult(interp, "bad menu entry type \"",
  2013.         argv[0], "\": must be cascade, checkbutton, ",
  2014.         "command, radiobutton, or separator", (char *) NULL);
  2015.     return TCL_ERROR;
  2016.     }
  2017.     
  2018.     /*
  2019.      * Now we have to add an entry for every instance related to this menu.
  2020.      */
  2021.  
  2022.     for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; 
  2023.             menuListPtr = menuListPtr->nextInstancePtr) {
  2024.         
  2025.         mePtr = MenuNewEntry(menuListPtr, index, type);
  2026.         if (mePtr == NULL) {
  2027.             return TCL_ERROR;
  2028.         }
  2029.         if (ConfigureMenuEntry(mePtr, argc-1, argv+1, 0) != TCL_OK) {
  2030.             Tcl_EventuallyFree((ClientData) mePtr,
  2031.                     DestroyMenuEntry);
  2032.             return TCL_ERROR;
  2033.         }
  2034.         
  2035.         /*
  2036.          * If a menu has cascades, then every instance of the menu has
  2037.          * to have its own parallel cascade structure. So adding an
  2038.      * entry to a menu with clones means that the menu that the
  2039.      * entry points to has to be cloned for every clone the
  2040.      * master menu has. This is special case #2 in the comment
  2041.      * at the top of this file.
  2042.          */
  2043.  
  2044.         if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {            
  2045.             if ((mePtr->name != NULL)  && (mePtr->childMenuRefPtr != NULL)
  2046.                     && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
  2047.                 TkMenu *cascadeMenuPtr =
  2048.             mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
  2049.                 char *newCascadeName;
  2050.           char *newArgv[2];
  2051.         TkMenuReferences *menuRefPtr;
  2052.                     
  2053.         newCascadeName = TkNewMenuName(menuListPtr->interp,
  2054.             Tk_PathName(menuListPtr->tkwin),
  2055.             cascadeMenuPtr);
  2056.         CloneMenu(cascadeMenuPtr, newCascadeName, "normal");
  2057.         
  2058.         menuRefPtr = TkFindMenuReferences(menuListPtr->interp,
  2059.             newCascadeName);
  2060.         if (menuRefPtr == NULL) {
  2061.             panic("CloneMenu failed inside of MenuAddOrInsert.");
  2062.         }
  2063.         newArgv[0] = "-menu";
  2064.         newArgv[1] = newCascadeName;
  2065.                 ConfigureMenuEntry(mePtr, 2, newArgv, 0);
  2066.                 ckfree(newCascadeName);
  2067.             }
  2068.         }
  2069.     }
  2070.     return TCL_OK;
  2071. }
  2072.  
  2073. /*
  2074.  *--------------------------------------------------------------
  2075.  *
  2076.  * MenuVarProc --
  2077.  *
  2078.  *    This procedure is invoked when someone changes the
  2079.  *    state variable associated with a radiobutton or checkbutton
  2080.  *    menu entry.  The entry's selected state is set to match
  2081.  *    the value of the variable.
  2082.  *
  2083.  * Results:
  2084.  *    NULL is always returned.
  2085.  *
  2086.  * Side effects:
  2087.  *    The menu entry may become selected or deselected.
  2088.  *
  2089.  *--------------------------------------------------------------
  2090.  */
  2091.  
  2092. static char *
  2093. MenuVarProc(clientData, interp, name1, name2, flags)
  2094.     ClientData clientData;    /* Information about menu entry. */
  2095.     Tcl_Interp *interp;        /* Interpreter containing variable. */
  2096.     char *name1;        /* First part of variable's name. */
  2097.     char *name2;        /* Second part of variable's name. */
  2098.     int flags;            /* Describes what just happened. */
  2099. {
  2100.     TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
  2101.     TkMenu *menuPtr;
  2102.     char *value;
  2103.  
  2104.     menuPtr = mePtr->menuPtr;
  2105.  
  2106.     /*
  2107.      * If the variable is being unset, then re-establish the
  2108.      * trace unless the whole interpreter is going away.
  2109.      */
  2110.  
  2111.     if (flags & TCL_TRACE_UNSETS) {
  2112.     mePtr->entryFlags &= ~ENTRY_SELECTED;
  2113.     if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
  2114.         Tcl_TraceVar(interp, mePtr->name,
  2115.             TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  2116.             MenuVarProc, clientData);
  2117.     }
  2118.     TkpConfigureMenuEntry(mePtr);
  2119.     TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
  2120.     return (char *) NULL;
  2121.     }
  2122.  
  2123.     /*
  2124.      * Use the value of the variable to update the selected status of
  2125.      * the menu entry.
  2126.      */
  2127.  
  2128.     value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY);
  2129.     if (value == NULL) {
  2130.     value = "";
  2131.     }
  2132.     if (strcmp(value, mePtr->onValue) == 0) {
  2133.     if (mePtr->entryFlags & ENTRY_SELECTED) {
  2134.         return (char *) NULL;
  2135.     }
  2136.     mePtr->entryFlags |= ENTRY_SELECTED;
  2137.     } else if (mePtr->entryFlags & ENTRY_SELECTED) {
  2138.     mePtr->entryFlags &= ~ENTRY_SELECTED;
  2139.     } else {
  2140.     return (char *) NULL;
  2141.     }
  2142.     TkpConfigureMenuEntry(mePtr);
  2143.     TkEventuallyRedrawMenu(menuPtr, mePtr);
  2144.     return (char *) NULL;
  2145. }
  2146.  
  2147. /*
  2148.  *----------------------------------------------------------------------
  2149.  *
  2150.  * TkActivateMenuEntry --
  2151.  *
  2152.  *    This procedure is invoked to make a particular menu entry
  2153.  *    the active one, deactivating any other entry that might
  2154.  *    currently be active.
  2155.  *
  2156.  * Results:
  2157.  *    The return value is a standard Tcl result (errors can occur
  2158.  *    while posting and unposting submenus).
  2159.  *
  2160.  * Side effects:
  2161.  *    Menu entries get redisplayed, and the active entry changes.
  2162.  *    Submenus may get posted and unposted.
  2163.  *
  2164.  *----------------------------------------------------------------------
  2165.  */
  2166.  
  2167. int
  2168. TkActivateMenuEntry(menuPtr, index)
  2169.     register TkMenu *menuPtr;        /* Menu in which to activate. */
  2170.     int index;                /* Index of entry to activate, or
  2171.                      * -1 to deactivate all entries. */
  2172. {
  2173.     register TkMenuEntry *mePtr;
  2174.     int result = TCL_OK;
  2175.  
  2176.     if (menuPtr->active >= 0) {
  2177.     mePtr = menuPtr->entries[menuPtr->active];
  2178.  
  2179.     /*
  2180.      * Don't change the state unless it's currently active (state
  2181.      * might already have been changed to disabled).
  2182.      */
  2183.  
  2184.     if (mePtr->state == tkActiveUid) {
  2185.         mePtr->state = tkNormalUid;
  2186.     }
  2187.     TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
  2188.     }
  2189.     menuPtr->active = index;
  2190.     if (index >= 0) {
  2191.     mePtr = menuPtr->entries[index];
  2192.     mePtr->state = tkActiveUid;
  2193.     TkEventuallyRedrawMenu(menuPtr, mePtr);
  2194.     }
  2195.     return result;
  2196. }
  2197.  
  2198. /*
  2199.  *----------------------------------------------------------------------
  2200.  *
  2201.  * TkPostCommand --
  2202.  *
  2203.  *    Execute the postcommand for the given menu.
  2204.  *
  2205.  * Results:
  2206.  *    The return value is a standard Tcl result (errors can occur
  2207.  *    while the postcommands are being processed).
  2208.  *
  2209.  * Side effects:
  2210.  *    Since commands can get executed while this routine is being executed,
  2211.  *    the entire world can change.
  2212.  *
  2213.  *----------------------------------------------------------------------
  2214.  */
  2215.  
  2216. int
  2217. TkPostCommand(menuPtr)
  2218.     TkMenu *menuPtr;
  2219. {
  2220.     int result;
  2221.  
  2222.     /*
  2223.      * If there is a command for the menu, execute it.  This
  2224.      * may change the size of the menu, so be sure to recompute
  2225.      * the menu's geometry if needed.
  2226.      */
  2227.  
  2228.     if (menuPtr->postCommand != NULL) {
  2229.         result = TkCopyAndGlobalEval(menuPtr->interp,
  2230.             menuPtr->postCommand);
  2231.     if (result != TCL_OK) {
  2232.         return result;
  2233.     }
  2234.     TkRecomputeMenu(menuPtr);
  2235.     }
  2236.     return TCL_OK;
  2237. }
  2238.  
  2239. /*
  2240.  *--------------------------------------------------------------
  2241.  *
  2242.  * CloneMenu --
  2243.  *
  2244.  *    Creates a child copy of the menu. It will be inserted into
  2245.  *    the menu's instance chain. All attributes and entry
  2246.  *    attributes will be duplicated.
  2247.  *
  2248.  * Results:
  2249.  *    A standard Tcl result.
  2250.  *
  2251.  * Side effects:
  2252.  *    Allocates storage. After the menu is created, any 
  2253.  *    configuration done with this menu or any related one
  2254.  *    will be reflected in all of them.
  2255.  *
  2256.  *--------------------------------------------------------------
  2257.  */
  2258.  
  2259. static int
  2260. CloneMenu(menuPtr, newMenuName, newMenuTypeString)
  2261.     TkMenu *menuPtr;        /* The menu we are going to clone */
  2262.     char *newMenuName;        /* The name to give the new menu */
  2263.     char *newMenuTypeString;    /* What kind of menu is this, a normal menu
  2264.                      * a menubar, or a tearoff? */
  2265. {
  2266.     int returnResult;
  2267.     int menuType;
  2268.     size_t length;
  2269.     TkMenuReferences *menuRefPtr;
  2270.     Tcl_Obj *commandObjPtr;
  2271.     
  2272.     if (newMenuTypeString == NULL) {
  2273.         menuType = MASTER_MENU;
  2274.     } else {
  2275.         length = strlen(newMenuTypeString);
  2276.         if (strncmp(newMenuTypeString, "normal", length) == 0) {
  2277.             menuType = MASTER_MENU;
  2278.         } else if (strncmp(newMenuTypeString, "tearoff", length) == 0) {
  2279.             menuType = TEAROFF_MENU;
  2280.         } else if (strncmp(newMenuTypeString, "menubar", length) == 0) {
  2281.             menuType = MENUBAR;
  2282.         } else {
  2283.             Tcl_AppendResult(menuPtr->interp, 
  2284.                     "bad menu type - must be normal, tearoff, or menubar",
  2285.                 (char *) NULL);
  2286.             return TCL_ERROR;
  2287.         }
  2288.     }
  2289.  
  2290.     commandObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
  2291.     Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
  2292.             Tcl_NewStringObj("tkMenuDup", -1));
  2293.     Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
  2294.             Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1));
  2295.     Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
  2296.             Tcl_NewStringObj(newMenuName, -1));
  2297.     if ((newMenuTypeString == NULL) || (newMenuTypeString[0] == '\0')) {
  2298.         Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
  2299.             Tcl_NewStringObj("normal", -1));
  2300.     } else {
  2301.         Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
  2302.             Tcl_NewStringObj(newMenuTypeString, -1));
  2303.     }
  2304.     Tcl_IncrRefCount(commandObjPtr);
  2305.     Tcl_Preserve((ClientData) menuPtr);
  2306.     returnResult = Tcl_EvalObj(menuPtr->interp, commandObjPtr);
  2307.     Tcl_DecrRefCount(commandObjPtr);
  2308.  
  2309.     /*
  2310.      * Make sure the tcl command actually created the clone.
  2311.      */
  2312.     
  2313.     if ((returnResult == TCL_OK) &&
  2314.             ((menuRefPtr = TkFindMenuReferences(menuPtr->interp, newMenuName))
  2315.         != (TkMenuReferences *) NULL)
  2316.         && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
  2317.         TkMenu *newMenuPtr = menuRefPtr->menuPtr;
  2318.     char *newArgv[3];
  2319.     int i, numElements;
  2320.  
  2321.     /*
  2322.      * Now put this newly created menu into the parent menu's instance
  2323.      * chain.
  2324.      */
  2325.  
  2326.     if (menuPtr->nextInstancePtr == NULL) {
  2327.         menuPtr->nextInstancePtr = newMenuPtr;
  2328.         newMenuPtr->masterMenuPtr = menuPtr->masterMenuPtr;
  2329.     } else {
  2330.         TkMenu *masterMenuPtr;
  2331.         
  2332.         masterMenuPtr = menuPtr->masterMenuPtr;
  2333.         newMenuPtr->nextInstancePtr = masterMenuPtr->nextInstancePtr;
  2334.         masterMenuPtr->nextInstancePtr = newMenuPtr;
  2335.         newMenuPtr->masterMenuPtr = masterMenuPtr;
  2336.     }
  2337.        
  2338.        /*
  2339.         * Add the master menu's window to the bind tags for this window
  2340.         * after this window's tag. This is so the user can bind to either
  2341.         * this clone (which may not be easy to do) or the entire menu
  2342.         * clone structure.
  2343.         */
  2344.        
  2345.        newArgv[0] = "bindtags";
  2346.        newArgv[1] = Tk_PathName(newMenuPtr->tkwin);
  2347.        if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, 
  2348.            newMenuPtr->interp, 2, newArgv) == TCL_OK) {
  2349.            char *windowName;
  2350.            Tcl_Obj *bindingsPtr = 
  2351.                    Tcl_NewStringObj(newMenuPtr->interp->result, -1);
  2352.            Tcl_Obj *elementPtr;
  2353.      
  2354.            Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
  2355.            for (i = 0; i < numElements; i++) {
  2356.                Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i,
  2357.             &elementPtr);
  2358.                windowName = Tcl_GetStringFromObj(elementPtr, NULL);
  2359.                if (strcmp(windowName, Tk_PathName(newMenuPtr->tkwin))
  2360.                    == 0) {
  2361.                    Tcl_Obj *newElementPtr = Tcl_NewStringObj(
  2362.                            Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);
  2363.                    Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
  2364.                            i + 1, 0, 1, &newElementPtr);
  2365.                    newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL);
  2366.                    Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
  2367.                            menuPtr->interp, 3, newArgv);
  2368.                    break;
  2369.                }
  2370.            }
  2371.            Tcl_DecrRefCount(bindingsPtr);           
  2372.        }
  2373.        Tcl_ResetResult(menuPtr->interp);
  2374.           
  2375.        /*
  2376.         * Clone all of the cascade menus that this menu points to.
  2377.         */
  2378.        
  2379.        for (i = 0; i < menuPtr->numEntries; i++) {
  2380.            char *newCascadeName;
  2381.            TkMenuReferences *cascadeRefPtr;
  2382.            TkMenu *oldCascadePtr;
  2383.            
  2384.            if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
  2385.         && (menuPtr->entries[i]->name != NULL)) {
  2386.                cascadeRefPtr =
  2387.             TkFindMenuReferences(menuPtr->interp,
  2388.             menuPtr->entries[i]->name);
  2389.                if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
  2390.                    char *nameString;
  2391.             
  2392.                    oldCascadePtr = cascadeRefPtr->menuPtr;
  2393.  
  2394.             nameString = Tk_PathName(newMenuPtr->tkwin);
  2395.                    newCascadeName = TkNewMenuName(menuPtr->interp,
  2396.                             nameString, oldCascadePtr);
  2397.             CloneMenu(oldCascadePtr, newCascadeName, NULL);
  2398.  
  2399.             newArgv[0] = "-menu";
  2400.             newArgv[1] = newCascadeName;
  2401.             ConfigureMenuEntry(newMenuPtr->entries[i], 2, newArgv, 
  2402.                     TK_CONFIG_ARGV_ONLY);
  2403.             ckfree(newCascadeName);
  2404.                }
  2405.            }
  2406.        }
  2407.        
  2408.         returnResult = TCL_OK;
  2409.     } else {
  2410.         returnResult = TCL_ERROR;
  2411.     }
  2412.     Tcl_Release((ClientData) menuPtr);
  2413.     return returnResult;
  2414. }
  2415.  
  2416. /*
  2417.  *----------------------------------------------------------------------
  2418.  *
  2419.  * MenuDoYPosition --
  2420.  *
  2421.  *    Given arguments from an option command line, returns the Y position.
  2422.  *
  2423.  * Results:
  2424.  *    Returns TCL_OK or TCL_Error
  2425.  *
  2426.  * Side effects:
  2427.  *    yPosition is set to the Y-position of the menu entry.
  2428.  *
  2429.  *----------------------------------------------------------------------
  2430.  */
  2431.     
  2432. static int
  2433. MenuDoYPosition(interp, menuPtr, arg)
  2434.     Tcl_Interp *interp;
  2435.     TkMenu *menuPtr;
  2436.     char *arg;
  2437. {
  2438.     int index;
  2439.     
  2440.     TkRecomputeMenu(menuPtr);
  2441.     if (TkGetMenuIndex(interp, menuPtr, arg, 0, &index) != TCL_OK) {
  2442.         goto error;
  2443.     }
  2444.     if (index < 0) {
  2445.         interp->result = "0";
  2446.     } else {
  2447.         sprintf(interp->result, "%d", menuPtr->entries[index]->y);
  2448.     }
  2449.     return TCL_OK;
  2450.     
  2451. error:
  2452.     return TCL_ERROR;
  2453. }
  2454.  
  2455. /*
  2456.  *----------------------------------------------------------------------
  2457.  *
  2458.  * GetIndexFromCoords --
  2459.  *
  2460.  *    Given a string of the form "@int", return the menu item corresponding
  2461.  *    to int.
  2462.  *
  2463.  * Results:
  2464.  *    If int is a valid number, *indexPtr will be the number of the menuentry
  2465.  *    that is the correct height. If int is invaled, *indexPtr will be
  2466.  *    unchanged. Returns appropriate Tcl error number.
  2467.  *
  2468.  * Side effects:
  2469.  *    If int is invalid, interp's result will set to NULL.
  2470.  *
  2471.  *----------------------------------------------------------------------
  2472.  */
  2473.  
  2474. static int
  2475. GetIndexFromCoords(interp, menuPtr, string, indexPtr)
  2476.     Tcl_Interp *interp;        /* interp of menu */
  2477.     TkMenu *menuPtr;        /* the menu we are searching */
  2478.     char *string;        /* The @string we are parsing */
  2479.     int *indexPtr;        /* The index of the item that matches */
  2480. {
  2481.     int x, y, i;
  2482.     char *p, *end;
  2483.     
  2484.     TkRecomputeMenu(menuPtr);
  2485.     p = string + 1;
  2486.     y = strtol(p, &end, 0);
  2487.     if (end == p) {
  2488.     goto error;
  2489.     }
  2490.     if (*end == ',') {
  2491.     x = y;
  2492.     p = end + 1;
  2493.     y = strtol(p, &end, 0);
  2494.     if (end == p) {
  2495.         goto error;
  2496.     }
  2497.     } else {
  2498.     x = menuPtr->borderWidth;
  2499.     }
  2500.     
  2501.     for (i = 0; i < menuPtr->numEntries; i++) {
  2502.     if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y)
  2503.         && (x < (menuPtr->entries[i]->x + menuPtr->entries[i]->width))
  2504.         && (y < (menuPtr->entries[i]->y
  2505.         + menuPtr->entries[i]->height))) {
  2506.         break;
  2507.     }
  2508.     }
  2509.     if (i >= menuPtr->numEntries) {
  2510.     /* i = menuPtr->numEntries - 1; */
  2511.     i = -1;
  2512.     }
  2513.     *indexPtr = i;
  2514.     return TCL_OK;
  2515.  
  2516.     error:
  2517.     Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
  2518.     return TCL_ERROR;
  2519. }
  2520.  
  2521. /*
  2522.  *----------------------------------------------------------------------
  2523.  *
  2524.  * RecursivelyDeleteMenu --
  2525.  *
  2526.  *    Deletes a menu and any cascades underneath it. Used for deleting
  2527.  *    instances when a menu is no longer being used as a menubar,
  2528.  *    for instance.
  2529.  *
  2530.  * Results:
  2531.  *    None.
  2532.  *
  2533.  * Side effects:
  2534.  *    Destroys the menu and all cascade menus underneath it.
  2535.  *
  2536.  *----------------------------------------------------------------------
  2537.  */
  2538.  
  2539. static void
  2540. RecursivelyDeleteMenu(menuPtr)
  2541.     TkMenu *menuPtr;        /* The menubar instance we are deleting */
  2542. {
  2543.     int i;
  2544.     TkMenuEntry *mePtr;
  2545.     
  2546.     for (i = 0; i < menuPtr->numEntries; i++) {
  2547.         mePtr = menuPtr->entries[i];
  2548.         if ((mePtr->type == CASCADE_ENTRY)
  2549.             && (mePtr->childMenuRefPtr != NULL)
  2550.             && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
  2551.             RecursivelyDeleteMenu(mePtr->childMenuRefPtr->menuPtr);
  2552.         }
  2553.     }
  2554.     Tk_DestroyWindow(menuPtr->tkwin);
  2555. }
  2556.  
  2557. /*
  2558.  *----------------------------------------------------------------------
  2559.  *
  2560.  * TkNewMenuName --
  2561.  *
  2562.  *    Makes a new unique name for a cloned menu. Will be a child
  2563.  *    of oldName.
  2564.  *
  2565.  * Results:
  2566.  *    Returns a char * which has been allocated; caller must free.
  2567.  *
  2568.  * Side effects:
  2569.  *    Memory is allocated.
  2570.  *
  2571.  *----------------------------------------------------------------------
  2572.  */
  2573.  
  2574. char *
  2575. TkNewMenuName(interp, parentName, menuPtr)
  2576.     Tcl_Interp *interp;        /* The interp the new name has to live in.*/
  2577.     char *parentName;        /* The prefix path of the new name. */
  2578.     TkMenu *menuPtr;        /* The menu we are cloning. */
  2579. {
  2580.     Tcl_DString resultDString;
  2581.     Tcl_DString childDString;
  2582.     char *destString;
  2583.     int offset, i;
  2584.     int doDot = parentName[strlen(parentName) - 1] != '.';
  2585.     Tcl_CmdInfo cmdInfo;
  2586.     char *returnString;
  2587.     Tcl_HashTable *nameTablePtr = NULL;
  2588.     TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
  2589.     if (winPtr->mainPtr != NULL) {
  2590.     nameTablePtr = &(winPtr->mainPtr->nameTable);
  2591.     }
  2592.     
  2593.     Tcl_DStringInit(&childDString);
  2594.     Tcl_DStringAppend(&childDString, Tk_PathName(menuPtr->tkwin), -1);
  2595.     for (destString = Tcl_DStringValue(&childDString);
  2596.             *destString != '\0'; destString++) {
  2597.         if (*destString == '.') {
  2598.             *destString = '#';
  2599.         }
  2600.     }
  2601.     
  2602.     offset = 0;
  2603.     
  2604.     for (i = 0; ; i++) {
  2605.         if (i == 0) {
  2606.             Tcl_DStringInit(&resultDString);
  2607.             Tcl_DStringAppend(&resultDString, parentName, -1);
  2608.             if (doDot) {
  2609.                 Tcl_DStringAppend(&resultDString, ".", -1);
  2610.             }
  2611.             Tcl_DStringAppend(&resultDString,
  2612.                     Tcl_DStringValue(&childDString), -1);
  2613.             destString = Tcl_DStringValue(&resultDString);
  2614.         } else {
  2615.             if (i == 1) {
  2616.                 offset = Tcl_DStringLength(&resultDString);
  2617.                 Tcl_DStringSetLength(&resultDString, offset + 10);
  2618.                 destString = Tcl_DStringValue(&resultDString);
  2619.             }
  2620.             sprintf(destString + offset, "%d", i);
  2621.         }
  2622.         if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0)
  2623.         && ((nameTablePtr == NULL)
  2624.         || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
  2625.             break;
  2626.         }
  2627.     }
  2628.     returnString = ckalloc(strlen(destString) + 1);
  2629.     strcpy(returnString, destString);
  2630.     Tcl_DStringFree(&resultDString);
  2631.     Tcl_DStringFree(&childDString);
  2632.     return returnString;           
  2633. }
  2634.  
  2635. /*
  2636.  *----------------------------------------------------------------------
  2637.  *
  2638.  * TkSetWindowMenuBar --
  2639.  *
  2640.  *    Associates a menu with a window. Called by ConfigureFrame in
  2641.  *    in response to a "-menu .foo" configuration option for a top
  2642.  *    level.
  2643.  *
  2644.  * Results:
  2645.  *    None.
  2646.  *
  2647.  * Side effects:
  2648.  *    The old menu clones for the menubar are thrown away, and a
  2649.  *    handler is set up to allocate the new ones.
  2650.  *
  2651.  *----------------------------------------------------------------------
  2652.  */
  2653. void
  2654. TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName)
  2655.     Tcl_Interp *interp;        /* The interpreter the toplevel lives in. */
  2656.     Tk_Window tkwin;        /* The toplevel window */
  2657.     char *oldMenuName;        /* The name of the menubar previously set in
  2658.                      * this toplevel. NULL means no menu was
  2659.                  * set previously. */
  2660.     char *menuName;        /* The name of the new menubar that the
  2661.                  * toplevel needs to be set to. NULL means
  2662.                  * that their is no menu now. */
  2663. {
  2664.     TkMenuTopLevelList *topLevelListPtr, *prevTopLevelPtr;
  2665.     TkMenu *menuPtr;
  2666.     TkMenuReferences *menuRefPtr;
  2667.     
  2668.     TkMenuInit();
  2669.  
  2670.     /*
  2671.      * Destroy the menubar instances of the old menu. Take this window
  2672.      * out of the old menu's top level reference list.
  2673.      */
  2674.     
  2675.     if (oldMenuName != NULL) {
  2676.         menuRefPtr = TkFindMenuReferences(interp, oldMenuName);
  2677.         if (menuRefPtr != NULL) {
  2678.  
  2679.         /*
  2680.          * Find the menubar instance that is to be removed. Destroy
  2681.          * it and all of the cascades underneath it.
  2682.          */
  2683.  
  2684.         if (menuRefPtr->menuPtr != NULL) {            
  2685.                 TkMenu *instancePtr;
  2686.  
  2687.                 menuPtr = menuRefPtr->menuPtr;
  2688.                         
  2689.                 for (instancePtr = menuPtr->masterMenuPtr;
  2690.                 instancePtr != NULL; 
  2691.                         instancePtr = instancePtr->nextInstancePtr) {
  2692.                     if (instancePtr->menuType == MENUBAR 
  2693.                         && instancePtr->parentTopLevelPtr == tkwin) {
  2694.                         RecursivelyDeleteMenu(instancePtr);
  2695.                         break;
  2696.                     }
  2697.                 }
  2698.             }
  2699.  
  2700.          /*
  2701.           * Now we need to remove this toplevel from the list of toplevels
  2702.          * that reference this menu.
  2703.           */
  2704.  
  2705.             for (topLevelListPtr = menuRefPtr->topLevelListPtr,
  2706.             prevTopLevelPtr = NULL;
  2707.             (topLevelListPtr != NULL) 
  2708.                     && (topLevelListPtr->tkwin != tkwin);
  2709.             prevTopLevelPtr = topLevelListPtr,
  2710.             topLevelListPtr = topLevelListPtr->nextPtr) {
  2711.  
  2712.         /*
  2713.          * Empty loop body.
  2714.          */
  2715.         
  2716.             }
  2717.  
  2718.         /*
  2719.          * Now we have found the toplevel reference that matches the
  2720.          * tkwin; remove this reference from the list.
  2721.          */
  2722.  
  2723.         if (topLevelListPtr != NULL) {
  2724.                 if (prevTopLevelPtr == NULL) {
  2725.             menuRefPtr->topLevelListPtr =
  2726.                 menuRefPtr->topLevelListPtr->nextPtr;
  2727.         } else {
  2728.                     prevTopLevelPtr->nextPtr = topLevelListPtr->nextPtr;
  2729.                 }
  2730.                 ckfree((char *) topLevelListPtr);
  2731.                 TkFreeMenuReferences(menuRefPtr);
  2732.             }
  2733.         }
  2734.     }
  2735.  
  2736.     /*
  2737.      * Now, add the clone references for the new menu.
  2738.      */
  2739.     
  2740.     if (menuName != NULL && menuName[0] != 0) {
  2741.         TkMenu *menuBarPtr = NULL;
  2742.  
  2743.     menuRefPtr = TkCreateMenuReferences(interp, menuName);        
  2744.         
  2745.         menuPtr = menuRefPtr->menuPtr;
  2746.         if (menuPtr != NULL) {
  2747.            char *cloneMenuName;
  2748.            TkMenuReferences *cloneMenuRefPtr;
  2749.         char *newArgv[4];
  2750.         
  2751.             /*
  2752.              * Clone the menu and all of the cascades underneath it.
  2753.              */
  2754.  
  2755.             cloneMenuName = TkNewMenuName(interp, Tk_PathName(tkwin),
  2756.                     menuPtr);
  2757.             CloneMenu(menuPtr, cloneMenuName, "menubar");
  2758.         
  2759.             cloneMenuRefPtr = TkFindMenuReferences(interp, cloneMenuName);
  2760.             if ((cloneMenuRefPtr != NULL)
  2761.             && (cloneMenuRefPtr->menuPtr != NULL)) {
  2762.                 cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
  2763.                 menuBarPtr = cloneMenuRefPtr->menuPtr;
  2764.         newArgv[0] = "-cursor";
  2765.         newArgv[1] = "";
  2766.         ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
  2767.             2, newArgv, TK_CONFIG_ARGV_ONLY);
  2768.             }
  2769.  
  2770.         TkpSetWindowMenuBar(tkwin, menuBarPtr);
  2771.                 
  2772.             ckfree(cloneMenuName);
  2773.         } else {
  2774.             TkpSetWindowMenuBar(tkwin, NULL);
  2775.     }
  2776.  
  2777.         
  2778.         /*
  2779.          * Add this window to the menu's list of windows that refer
  2780.          * to this menu.
  2781.          */
  2782.  
  2783.         topLevelListPtr = (TkMenuTopLevelList *)
  2784.         ckalloc(sizeof(TkMenuTopLevelList));
  2785.         topLevelListPtr->tkwin = tkwin;
  2786.         topLevelListPtr->nextPtr = menuRefPtr->topLevelListPtr;
  2787.         menuRefPtr->topLevelListPtr = topLevelListPtr;
  2788.     } else {
  2789.     TkpSetWindowMenuBar(tkwin, NULL);
  2790.     }
  2791.     TkpSetMainMenubar(interp, tkwin, menuName);
  2792. }
  2793.  
  2794. /*
  2795.  *----------------------------------------------------------------------
  2796.  *
  2797.  * DestroyMenuHashTable --
  2798.  *
  2799.  *    Called when an interp is deleted and a menu hash table has
  2800.  *    been set in it.
  2801.  *
  2802.  * Results:
  2803.  *    None.
  2804.  *
  2805.  * Side effects:
  2806.  *    The hash table is destroyed.
  2807.  *
  2808.  *----------------------------------------------------------------------
  2809.  */
  2810.  
  2811. static void
  2812. DestroyMenuHashTable(clientData, interp)
  2813.     ClientData clientData;    /* The menu hash table we are destroying */
  2814.     Tcl_Interp *interp;        /* The interpreter we are destroying */
  2815. {
  2816.     Tcl_DeleteHashTable((Tcl_HashTable *) clientData);
  2817.     ckfree((char *) clientData);
  2818. }
  2819.  
  2820. /*
  2821.  *----------------------------------------------------------------------
  2822.  *
  2823.  * TkGetMenuHashTable --
  2824.  *
  2825.  *    For a given interp, give back the menu hash table that goes with
  2826.  *    it. If the hash table does not exist, it is created.
  2827.  *
  2828.  * Results:
  2829.  *    Returns a hash table pointer.
  2830.  *
  2831.  * Side effects:
  2832.  *    A new hash table is created if there were no table in the interp
  2833.  *    originally.
  2834.  *
  2835.  *----------------------------------------------------------------------
  2836.  */
  2837.  
  2838. Tcl_HashTable *
  2839. TkGetMenuHashTable(interp)
  2840.     Tcl_Interp *interp;        /* The interp we need the hash table in.*/
  2841. {
  2842.     Tcl_HashTable *menuTablePtr;
  2843.  
  2844.     menuTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, MENU_HASH_KEY,
  2845.         NULL);
  2846.     if (menuTablePtr == NULL) {
  2847.     menuTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
  2848.     Tcl_InitHashTable(menuTablePtr, TCL_STRING_KEYS);
  2849.     Tcl_SetAssocData(interp, MENU_HASH_KEY, DestroyMenuHashTable,
  2850.         (ClientData) menuTablePtr);
  2851.     }
  2852.     return menuTablePtr;
  2853. }
  2854.  
  2855. /*
  2856.  *----------------------------------------------------------------------
  2857.  *
  2858.  * TkCreateMenuReferences --
  2859.  *
  2860.  *    Given a pathname, gives back a pointer to a TkMenuReferences structure.
  2861.  *    If a reference is not already in the hash table, one is created.
  2862.  *
  2863.  * Results:
  2864.  *    Returns a pointer to a menu reference structure. Should not
  2865.  *    be freed by calller; when a field of the reference is cleared,
  2866.  *    TkFreeMenuReferences should be called.
  2867.  *
  2868.  * Side effects:
  2869.  *    A new hash table entry is created if there were no references
  2870.  *    to the menu originally.
  2871.  *
  2872.  *----------------------------------------------------------------------
  2873.  */
  2874.  
  2875. TkMenuReferences *
  2876. TkCreateMenuReferences(interp, pathName)
  2877.     Tcl_Interp *interp;
  2878.     char *pathName;        /* The path of the menu widget */
  2879. {
  2880.     Tcl_HashEntry *hashEntryPtr;
  2881.     TkMenuReferences *menuRefPtr;
  2882.     int newEntry;
  2883.     Tcl_HashTable *menuTablePtr = TkGetMenuHashTable(interp);
  2884.  
  2885.     hashEntryPtr = Tcl_CreateHashEntry(menuTablePtr, pathName, &newEntry);
  2886.     if (newEntry) {
  2887.         menuRefPtr = (TkMenuReferences *) ckalloc(sizeof(TkMenuReferences));
  2888.         menuRefPtr->menuPtr = NULL;
  2889.         menuRefPtr->topLevelListPtr = NULL;
  2890.         menuRefPtr->parentEntryPtr = NULL;
  2891.         menuRefPtr->hashEntryPtr = hashEntryPtr;
  2892.         Tcl_SetHashValue(hashEntryPtr, (char *) menuRefPtr);
  2893.     } else {
  2894.         menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
  2895.     }
  2896.     return menuRefPtr;
  2897. }
  2898.  
  2899. /*
  2900.  *----------------------------------------------------------------------
  2901.  *
  2902.  * TkFindMenuReferences --
  2903.  *
  2904.  *    Given a pathname, gives back a pointer to the TkMenuReferences
  2905.  *    structure.
  2906.  *
  2907.  * Results:
  2908.  *    Returns a pointer to a menu reference structure. Should not
  2909.  *    be freed by calller; when a field of the reference is cleared,
  2910.  *    TkFreeMenuReferences should be called. Returns NULL if no reference
  2911.  *    with this pathname exists.
  2912.  *
  2913.  * Side effects:
  2914.  *    None.
  2915.  *
  2916.  *----------------------------------------------------------------------
  2917.  */
  2918.  
  2919. TkMenuReferences *
  2920. TkFindMenuReferences(interp, pathName)
  2921.     Tcl_Interp *interp;        /* The interp the menu is living in. */
  2922.     char *pathName;        /* The path of the menu widget */
  2923. {
  2924.     Tcl_HashEntry *hashEntryPtr;
  2925.     TkMenuReferences *menuRefPtr = NULL;
  2926.     Tcl_HashTable *menuTablePtr;
  2927.  
  2928.     menuTablePtr = TkGetMenuHashTable(interp);
  2929.     hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, pathName);
  2930.     if (hashEntryPtr != NULL) {
  2931.         menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
  2932.     }
  2933.     return menuRefPtr;
  2934. }
  2935.  
  2936. /*
  2937.  *----------------------------------------------------------------------
  2938.  *
  2939.  * TkFreeMenuReferences --
  2940.  *
  2941.  *    This is called after one of the fields in a menu reference
  2942.  *    is cleared. It cleans up the ref if it is now empty.
  2943.  *
  2944.  * Results:
  2945.  *    None.
  2946.  *
  2947.  * Side effects:
  2948.  *    If this is the last field to be cleared, the menu ref is
  2949.  *    taken out of the hash table.
  2950.  *
  2951.  *----------------------------------------------------------------------
  2952.  */
  2953.  
  2954. void
  2955. TkFreeMenuReferences(menuRefPtr)
  2956.     TkMenuReferences *menuRefPtr;        /* The menu reference to
  2957.                          * free */
  2958. {
  2959.     if ((menuRefPtr->menuPtr == NULL) 
  2960.             && (menuRefPtr->parentEntryPtr == NULL)
  2961.             && (menuRefPtr->topLevelListPtr == NULL)) {
  2962.         Tcl_DeleteHashEntry(menuRefPtr->hashEntryPtr);
  2963.         ckfree((char *) menuRefPtr);
  2964.     }
  2965. }
  2966.  
  2967. /*
  2968.  *----------------------------------------------------------------------
  2969.  *
  2970.  * DeleteMenuCloneEntries --
  2971.  *
  2972.  *    For every clone in this clone chain, delete the menu entries
  2973.  *    given by the parameters.
  2974.  *
  2975.  * Results:
  2976.  *    None.
  2977.  *
  2978.  * Side effects:
  2979.  *    The appropriate entries are deleted from all clones of this menu.
  2980.  *
  2981.  *----------------------------------------------------------------------
  2982.  */
  2983.  
  2984. static void
  2985. DeleteMenuCloneEntries(menuPtr, first, last)
  2986.     TkMenu *menuPtr;            /* the menu the command was issued with */
  2987.     int    first;                /* the zero-based first entry in the set
  2988.                      * of entries to delete. */
  2989.     int last;                /* the zero-based last entry */
  2990. {
  2991.  
  2992.     TkMenu *menuListPtr;
  2993.     int curFirst, curLast, numDeleted, i;
  2994.  
  2995.     numDeleted = last + 1 - first;
  2996.     for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
  2997.         menuListPtr = menuListPtr->nextInstancePtr) {
  2998.     if ((menuPtr == menuListPtr) ||
  2999.         (menuPtr->tearOff == menuListPtr->tearOff)) {
  3000.         curFirst = first;
  3001.         curLast = last;
  3002.     } else if (menuPtr->tearOff) {
  3003.         curFirst = first - 1;
  3004.         curLast = last - 1;
  3005.     } else {
  3006.         curFirst = first + 1;
  3007.         curLast = last + 1;
  3008.     }
  3009.  
  3010.     for (i = curLast; i >= curFirst; i--) {
  3011.         Tcl_EventuallyFree((ClientData) menuListPtr->entries[i],
  3012.             DestroyMenuEntry);
  3013.     }
  3014.     if ((menuListPtr->active >= curFirst) 
  3015.         && (menuListPtr->active <= curLast)) {
  3016.         menuListPtr->active = -1;
  3017.     } else if (menuListPtr->active > curLast) {
  3018.         menuListPtr->active -= numDeleted;
  3019.     }
  3020.     TkEventuallyRecomputeMenu(menuListPtr);
  3021.     }
  3022. }
  3023.  
  3024. /*
  3025.  *----------------------------------------------------------------------
  3026.  *
  3027.  * TkMenuInit --
  3028.  *
  3029.  *    Sets up the hash tables and the variables used by the menu package.
  3030.  *
  3031.  * Results:
  3032.  *    None.
  3033.  *
  3034.  * Side effects:
  3035.  *    lastMenuID gets initialized, and the parent hash and the command hash
  3036.  *    are allocated.
  3037.  *
  3038.  *----------------------------------------------------------------------
  3039.  */
  3040.  
  3041. void
  3042. TkMenuInit()
  3043. {
  3044.     if (!menusInitialized) {
  3045.         TkpMenuInit();
  3046.         menusInitialized = 1;
  3047.     }
  3048. }
  3049.